# The LearningOnline Network with CAPA # User Roles Screen # (Directory Indexer # (Login Screen # 5/21/99,5/22,5/25,5/26,5/31,6/2,6/10,7/12,7/14 Gerd Kortemeyer) # 11/23 Gerd Kortemeyer) # 1/14,03/06,06/01,07/22,07/24,07/25, # 09/04,09/06,09/28,09/29,09/30 Gerd Kortemeyer # package Apache::lonroles; use strict; use Apache::lonnet(); use Apache::lonuserstate(); use Apache::Constants qw(:common); use Apache::File(); sub handler { my $r = shift; $r->content_type('text/html'); $r->send_http_header; return OK if $r->header_only; # ---------------------------------------------------------------- Print Header $r->print(< LON-CAPA User Roles ENDHEADER my $now=time; my $then=$ENV{'user.login.time'}; my $envkey; # ================================================================== Roles Init if ($ENV{'form.selectrole'}) { foreach $envkey (keys %ENV) { if ($envkey=~/^user\.role\./) { my ($dum1,$dum2,$role,@pwhere)=split(/\./,$envkey); my $where=join('.',@pwhere); my $trolecode=$role.'.'.$where; if ($ENV{'form.'.$trolecode}) { my ($tstart,$tend)=split(/\./,$ENV{$envkey}); my $tstatus='is'; if ($tstart) { if ($tstart>$then) { $tstatus='future'; } } if ($tend) { if ($tend<$then) { $tstatus='expired'; } if ($tend>$now) { $tstatus='will_not'; } } if ($tstatus eq 'is') { &Apache::lonnet::appenv('request.role' => $trolecode); my ($cdom,$cnum)=split(/\//,$where); if ($cnum) { $r->print( &Apache::lonuserstate::readmap($where) ); } } } } } $r->print('

Role not active

'); return OK; } # =============================================================== No Roles Init # ------------------------------------------ Get Error Message from Environment my ($fn,$priv,$nochoose,$error,$msg)=split(/:/,$ENV{'user.error.msg'}); $r->log_reason( "$msg for $ENV{'user.name'} domain $ENV{'user.domain'} access $priv",$fn); # ---------------------------------------------------------------- Who is this? my $advanced=0; foreach $envkey (keys %ENV) { if ($envkey=~/^user\.role\./) { my ($dum1,$dum2,$role,@pwhere)=split(/\./,$envkey); if ($role ne 'st') { $advanced=1; } } } # -------------------------------------------------------- Generate Page Output # --------------------------------------------------------------- Error Header? if ($error) { $r->print("

LON-CAPA Access Control

"); $r->print("
Access  : ".
                  Apache::lonnet::plaintext($priv)."\n");
        $r->print("Resource: $fn\n");
        $r->print("Action  : $msg\n
"); } else { $r->print("

LON-CAPA User Roles

"); } # -------------------------------------------------------- Choice or no choice? if ($nochoose) { if ($advanced) { $r->print("

Assigned User Roles

\n"); } else { $r->print("

Sorry ...

\nThis resource might be part of"); if ($ENV{'request.course.id'}) { $r->print(' another'); } else { $r->print(' a certain'); } $r->print(' course.'); return OK; } } else { if ($advanced) { $r->print("

Select a User Role

\n"); } else { $r->print("

Enter a Course

\n"); } $r->print('
'); $r->print(''); $r->print(''); } # ----------------------------------------------------------------------- Table $r->print(''); unless ($nochoose) { $r->print(''); } if ($advanced) { $r->print(''. ''."\n"); } else { $r->print(''."\n"); } foreach $envkey (sort keys %ENV) { if ($envkey=~/^user\.role\./) { my ($dum1,$dum2,$role,@pwhere)=split(/\./,$envkey); my $where=join('.',@pwhere); my $trolecode=$role.'.'.$where; my ($tstart,$tend)=split(/\./,$ENV{$envkey}); my $tremark=''; my $tstatus='is'; my $tpstart=' '; my $tpend=' '; if ($tstart) { if ($tstart>$then) { $tstatus='future'; if ($tstart<$now) { $tstatus='will'; } } $tpstart=localtime($tstart); } if ($tend) { if ($tend<$then) { $tstatus='expired'; } if ($tend>$now) { $tstatus='will_not'; } $tpend=localtime($tend); } if ($ENV{'request.role'} eq $trolecode) { $tstatus='selected'; } my $tbg; if ($tstatus eq 'is') { $tbg='#77FF77'; } elsif ($tstatus eq 'future') { $tbg='#FFFF77'; } elsif ($tstatus eq 'will') { $tbg='#FFAA77'; $tremark.='Active at next login. '; } elsif ($tstatus eq 'expired') { $tbg='#FF7777'; } elsif ($tstatus eq 'will_not') { $tbg='#AAFF77'; $tremark.='Expired after logout. '; } elsif ($tstatus eq 'selected') { $tbg='#33FF33'; $tremark.='Currently selected. '; } my $trole; if ($role =~ /^cr\//) { my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$role); $tremark.='
Defined by '.$rauthor.' at '.$rdomain.'.'; $trole=$rrole; } else { $trole=Apache::lonnet::plaintext($role); } my $ttype; my $twhere; my ($tres,$tdom,$trest)=split(/\//,$where); if ($trest) { $ttype='Course'; $twhere=$tdom.'/'.$trest; } elsif ($tdom) { $ttype='Domain'; $twhere=$tdom; } else { $ttype='System'; $twhere='/'; } $r->print(''); unless ($nochoose) { if ($tstatus eq 'is') { $r->print(''); } else { $r->print(''); } } $r->print(''."\n"); } } $r->print('
 User RoleExtentStartEndRemark
Course
 '.$trole.''. $ttype.''.$twhere.''.$tpstart. ''.$tpend. ''.$tremark.' 
'); unless ($nochoose) { $r->print("
\n"); } # ------------------------------------------------------------ Priviledges Info if ($advanced) { $r->print('

Priviledges

'); foreach $envkey (sort keys %ENV) { if ($envkey=~/^user\.priv\./) { my ($dum1,$dum2,@pwhere)=split(/\./,$envkey); my $where=join('.',@pwhere); my $ttype; my $twhere; my ($tres,$tdom,$trest)=split(/\//,$where); if ($trest) { $ttype='Course'; $twhere=$tdom.'/'.$trest; } elsif ($tdom) { $ttype='Domain'; $twhere=$tdom; } else { $ttype='System'; $twhere='/'; } $r->print("\n

".$ttype.': '.$twhere.'

'); } } } # -------------------------------------------------------------- Debug - remove $->print("

Debugging

\n"); foreach $envkey (sort keys %ENV) { $r->print("$envkey ---- $ENV{$envkey}
"); } # ------------------------------------------------------------------- End Debug $r->print("\n"); return OK; } 1; __END__