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

Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.1332 and 1.1337

version 1.1332, 2017/01/02 19:44:20 version 1.1337, 2017/02/25 20:00:41
Line 650  sub transfer_profile_to_env { Line 650  sub transfer_profile_to_env {
 sub check_for_valid_session {  sub check_for_valid_session {
     my ($r,$name,$userhashref) = @_;      my ($r,$name,$userhashref) = @_;
     my %cookies=CGI::Cookie->parse($r->header_in('Cookie'));      my %cookies=CGI::Cookie->parse($r->header_in('Cookie'));
       my ($linkname,$pubname);
     if ($name eq '') {      if ($name eq '') {
         $name = 'lonID';          $name = 'lonID';
           $linkname = 'lonLinkID';
           $pubname = 'lonPubID';
     }      }
     my $lonid=$cookies{$name};      my $lonid=$cookies{$name};
       if (!$lonid) {
           if (($name eq 'lonID') && ($ENV{'SERVER_PORT'} != 443) && ($linkname)) {
               $lonid=$cookies{$linkname};
           }
           if (!$lonid) {
               if (($name eq 'lonID') && ($pubname)) {
                   $lonid=$cookies{$pubname};
               }
           }
       }
     return undef if (!$lonid);      return undef if (!$lonid);
   
     my $handle=&LONCAPA::clean_handle($lonid->value);      my $handle=&LONCAPA::clean_handle($lonid->value);
Line 4116  sub flushcourselogs { Line 4129  sub flushcourselogs {
         }          }
     }      }
 #  #
 # Reverse lookup of domain roles (dc, ad, li, sc, dh, au)  # Reverse lookup of domain roles (dc, ad, li, sc, dh, da, au)
 #  #
     my %domrolebuffer = ();      my %domrolebuffer = ();
     foreach my $entry (keys(%domainrolehash)) {      foreach my $entry (keys(%domainrolehash)) {
Line 4263  sub userrolelog { Line 4276  sub userrolelog {
          {$trole.':'.$username.':'.$domain.':'.$env{'user.name'}.':'.$env{'user.domain'}.':'}           {$trole.':'.$username.':'.$domain.':'.$env{'user.name'}.':'.$env{'user.domain'}.':'}
                     =$tend.':'.$tstart;                      =$tend.':'.$tstart;
     }      }
     if ($trole =~ /^(dc|ad|li|au|dg|sc|dh)/ ) {      if ($trole =~ /^(dc|ad|li|au|dg|sc|dh|da)/ ) {
        my (undef,$rudom,$runame,$rsec)=split(/\//,$area);         my (undef,$rudom,$runame,$rsec)=split(/\//,$area);
        $domainrolehash         $domainrolehash
          {$trole.':'.$username.':'.$domain.':'.$runame.':'.$rudom.':'.$rsec}           {$trole.':'.$username.':'.$domain.':'.$runame.':'.$rudom.':'.$rsec}
Line 4490  sub get_my_roles { Line 4503  sub get_my_roles {
     return %returnhash;      return %returnhash;
 }  }
   
   sub get_all_adhocroles {
       my ($dom) = @_;
       my @roles_by_num = ();
       my %domdefaults = &get_domain_defaults($dom);
       my (%description,%access_in_dom,%access_info);
       if (ref($domdefaults{'adhocroles'}) eq 'HASH') {
           my $count = 0;
           my %domcurrent = %{$domdefaults{'adhocroles'}};
           my %ordered;
           foreach my $role (sort(keys(%domcurrent))) {
               my ($order,$desc,$access_in_dom);
               if (ref($domcurrent{$role}) eq 'HASH') {
                   $order = $domcurrent{$role}{'order'};
                   $desc = $domcurrent{$role}{'desc'};
                   $access_in_dom{$role} = $domcurrent{$role}{'access'};
                   $access_info{$role} = $domcurrent{$role}{$access_in_dom{$role}};
               }
               if ($order eq '') {
                   $order = $count;
               }
               $ordered{$order} = $role;
               if ($desc ne '') {
                   $description{$role} = $desc;
               } else {
                   $description{$role}= $role;
               }
               $count++;
           }
           foreach my $item (sort {$a <=> $b } (keys(%ordered))) {
               push(@roles_by_num,$ordered{$item});
           }
       }
       return (\@roles_by_num,\%description,\%access_in_dom,\%access_info);
   }
   
 sub get_my_adhocroles {  sub get_my_adhocroles {
     my ($cid) = @_;      my ($cid,$checkreg) = @_;
     my (@possroles,%description);      my ($cdom,$cnum,%info,@possroles,$description,$roles_by_num);
     if ($cid =~ /^($match_domain)_($match_courseid)$/) {      if ($env{'request.course.id'} eq $cid) {
         my $cdom = $1;          $cdom = $env{'course.'.$cid.'.domain'};
         my $cnum = $2;          $cnum = $env{'course.'.$cid.'.num'};
         if ($env{"user.role.dh./$cdom/"}) {          $info{'internal.coursecode'} = $env{'course.'.$cid.'.internal.coursecode'};
       } elsif ($cid =~ /^($match_domain)_($match_courseid)$/) {
           $cdom = $1;
           $cnum = $2;
           %info = &Apache::lonnet::get('environment',['internal.coursecode'],
                                        $cdom,$cnum);
       }
       if (($info{'internal.coursecode'} ne '') && ($checkreg)) {
           my $user = $env{'user.name'}.':'.$env{'user.domain'};
           my %rosterhash = &get('classlist',[$user],$cdom,$cnum);
           if ($rosterhash{$user} ne '') {
               my $type = (split(/:/,$rosterhash{$user}))[5];
               return ([],{}) if ($type eq 'auto');
           }
       }
       if (($cdom ne '') && ($cnum ne ''))  {
           if (($env{"user.role.dh./$cdom/"}) || ($env{"user.role.da./$cdom/"})) {
             my $then=$env{'user.login.time'};              my $then=$env{'user.login.time'};
             my $update=$env{'user.update.time'};              my $update=$env{'user.update.time'};
             my $liverole = 1;              if (!$update) {
             my ($tstart,$tend)=split(/\./,$env{'user.role.dh./'.$cdom});                  $update = $then;
             my $limit = $update;              }
             if ($env{'request.role'} eq 'dh./'.$cdom.'/') {              my @liveroles;
                 $limit = $then;              foreach my $role ('dh','da') {
             }                  if ($env{"user.role.$role./$cdom/"}) {
             if ($tstart && $tstart>$limit) { $liverole = 0; }                      my ($tstart,$tend)=split(/\./,$env{"user.role.$role./$cdom/"});
             if ($tend   && $tend  <$limit) { $liverole = 0; }                      my $limit = $update;
             if ($liverole) {                      if ($env{'request.role'} eq "$role./$cdom/") {
                           $limit = $then;
                       }
                       my $activerole = 1;
                       if ($tstart && $tstart>$limit) { $activerole = 0; }
                       if ($tend   && $tend  <$limit) { $activerole = 0; }
                       if ($activerole) {
                           push(@liveroles,$role);
                       }
                   }
               }
               if (@liveroles) {
                 if (&homeserver($cnum,$cdom) ne 'no_host') {                  if (&homeserver($cnum,$cdom) ne 'no_host') {
                     my %domdefaults = &get_domain_defaults($cdom);                      my ($accessref,$accessinfo,%access_in_dom);
                     if (ref($domdefaults{'adhocroles'}) eq 'HASH') {                      ($roles_by_num,$description,$accessref,$accessinfo) = &get_all_adhocroles($cdom);
                         my $count = 0;                      if (ref($roles_by_num) eq 'ARRAY') {
                         my %domcurrent = %{$domdefaults{'adhocroles'}};                          if (@{$roles_by_num}) {
                         my (%ordered,%access_in_dom);  
                         foreach my $role (sort(keys(%domcurrent))) {  
                             my ($order,$desc,$access_in_dom);  
                             if (ref($domcurrent{$role}) eq 'HASH') {  
                                 $order = $domcurrent{$role}{'order'};  
                                 $desc = $domcurrent{$role}{'desc'};  
                                 $access_in_dom{$role} = $domcurrent{$role}{'access'};  
                             }  
                             if ($order eq '') {  
                                 $order = $count;  
                             }  
                             $ordered{$order} = $role;  
                             if ($desc ne '') {  
                                 $description{$role} = $desc;  
                             } else {  
                                 $description{$role}= $role;  
                             }  
                             $count++;  
                         }  
                         my @roles_by_num = ();  
                         foreach my $item (sort {$a <=> $b } (keys(%ordered))) {  
                             push(@roles_by_num,$ordered{$item});  
                         }  
                         if (@roles_by_num) {  
                             my %settings;                              my %settings;
                             if ($env{'request.course.id'} eq $cid) {                              if ($env{'request.course.id'} eq $cid) {
                                 foreach my $envkey (keys(%env)) {                                  foreach my $envkey (keys(%env)) {
Line 4556  sub get_my_adhocroles { Line 4607  sub get_my_adhocroles {
                                 @statuses = split(/,/,$env{'environment.inststatus'});                                  @statuses = split(/,/,$env{'environment.inststatus'});
                             }                              }
                             my $user = $env{'user.name'}.':'.$env{'user.domain'};                              my $user = $env{'user.name'}.':'.$env{'user.domain'};
                             foreach my $role (@roles_by_num) {                              if (ref($accessref) eq 'HASH') {
                                   %access_in_dom = %{$accessref};
                               }
                               foreach my $role (@{$roles_by_num}) {
                                 my ($curraccess,@okstatus,@personnel);                                  my ($curraccess,@okstatus,@personnel);
                                 if ($setincrs{$role}) {                                  if ($setincrs{$role}) {
                                     ($curraccess,my $rest) = split(/=/,$settings{'internal.adhoc.'.$role});                                      ($curraccess,my $rest) = split(/=/,$settings{'internal.adhoc.'.$role});
Line 4567  sub get_my_adhocroles { Line 4621  sub get_my_adhocroles {
                                     }                                      }
                                 } else {                                  } else {
                                     $curraccess = $access_in_dom{$role};                                      $curraccess = $access_in_dom{$role};
                                     if ($curraccess eq 'status') {                                      if (ref($accessinfo) eq 'HASH') {
                                         if (ref($domcurrent{$role}{$curraccess}) eq 'ARRAY') {                                          if ($curraccess eq 'status') {
                                             @okstatus = @{$domcurrent{$role}{$curraccess}};                                              if (ref($accessinfo->{$role}) eq 'ARRAY') {
                                         }                                                  @okstatus = @{$accessinfo->{$role}};
                                     } elsif (($curraccess eq 'exc') || ($curraccess eq 'inc')) {                                              }
                                         if (ref($domcurrent{$role}{$curraccess}) eq 'ARRAY') {                                          } elsif (($curraccess eq 'exc') || ($curraccess eq 'inc')) {
                                             @personnel = @{$domcurrent{$role}{$curraccess}};                                              if (ref($accessinfo->{$role}) eq 'ARRAY') {
                                                   @personnel = @{$accessinfo->{$role}};
                                               }
                                         }                                          }
                                     }                                      }
                                 }                                  }
Line 4581  sub get_my_adhocroles { Line 4637  sub get_my_adhocroles {
                                     next;                                      next;
                                 } elsif ($curraccess eq 'all') {                                  } elsif ($curraccess eq 'all') {
                                     push(@possroles,$role);                                      push(@possroles,$role);
                                   } elsif ($curraccess eq 'dh') {
                                       if (grep(/^dh$/,@liveroles)) {
                                           push(@possroles,$role);
                                       } else {
                                           next;
                                       }
                                   } elsif ($curraccess eq 'da') {
                                       if (grep(/^da$/,@liveroles)) {
                                           push(@possroles,$role);
                                       } else {
                                           next;
                                       }
                                 } elsif ($curraccess eq 'status') {                                  } elsif ($curraccess eq 'status') {
                                     if (@okstatus) {                                      if (@okstatus) {
                                         if (!@statuses) {                                          if (!@statuses) {
Line 4612  sub get_my_adhocroles { Line 4680  sub get_my_adhocroles {
             }              }
         }          }
     }      }
     return (\@possroles,\%description);      unless (ref($description) eq 'HASH') {
           if (ref($roles_by_num) eq 'ARRAY') {
               my %desc;
               map { $desc{$_} = $_; } (@{$roles_by_num});
               $description = \%desc;
           } else {
               $description = {};
           }
       }
       return (\@possroles,$description);
 }  }
   
 # ----------------------------------------------------- Frontpage Announcements  # ----------------------------------------------------- Frontpage Announcements
Line 9086  sub assignrole { Line 9163  sub assignrole {
             &courserolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag,              &courserolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag,
                            $selfenroll,$context);                             $selfenroll,$context);
         } elsif (($role eq 'li') || ($role eq 'dg') || ($role eq 'sc') ||          } elsif (($role eq 'li') || ($role eq 'dg') || ($role eq 'sc') ||
                  ($role eq 'au') || ($role eq 'dc') || ($role eq 'dh')) {                   ($role eq 'au') || ($role eq 'dc') || ($role eq 'dh') ||
                    ($role eq 'da')) {
             &domainrolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag,              &domainrolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag,
                            $context);                             $context);
         } elsif (($role eq 'ca') || ($role eq 'aa')) {          } elsif (($role eq 'ca') || ($role eq 'aa')) {
Removed from v.1.1332  
changed lines
  Added in v.1.1337

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