File:  [LON-CAPA] / loncom / auth / lonroles.pm
Revision 1.13: download - view: text, annotated - select for diffs
Thu Oct 26 18:54:11 2000 UTC (23 years, 8 months ago) by www
Branches: MAIN
CVS tags: HEAD
Now recognizes sections and writes to nohist_coursedescriptions

    1: # The LearningOnline Network with CAPA
    2: # User Roles Screen
    3: # (Directory Indexer
    4: # (Login Screen
    5: # 5/21/99,5/22,5/25,5/26,5/31,6/2,6/10,7/12,7/14 Gerd Kortemeyer)
    6: # 11/23 Gerd Kortemeyer)
    7: # 1/14,03/06,06/01,07/22,07/24,07/25,
    8: # 09/04,09/06,09/28,09/29,09/30,10/2,10/5,10/26 Gerd Kortemeyer
    9: #
   10: package Apache::lonroles;
   11: 
   12: use strict;
   13: use Apache::lonnet();
   14: use Apache::lonuserstate();
   15: use Apache::Constants qw(:common);
   16: use Apache::File();
   17: 
   18: sub handler {
   19: 
   20:     my $r = shift;
   21: 
   22:     my $now=time;
   23:     my $then=$ENV{'user.login.time'};
   24:     my $envkey;
   25: 
   26: 
   27: # ================================================================== Roles Init
   28: 
   29:     if ($ENV{'form.selectrole'}) {
   30:        &Apache::lonnet::appenv("request.course.id"  => '',
   31:                                "request.course.fn"  => '',
   32:                                "request.course.uri" => '',
   33:                                "request.course.sec" => '',
   34:                                "request.role" => 'cm'); 
   35:         foreach $envkey (keys %ENV) {
   36:          if ($envkey=~/^user\.role\./) {
   37: 	    my ($dum1,$dum2,$role,@pwhere)=split(/\./,$envkey);
   38:             my $where=join('.',@pwhere);
   39:             my $trolecode=$role.'.'.$where;
   40:             if ($ENV{'form.'.$trolecode}) {
   41:                my ($tstart,$tend)=split(/\./,$ENV{$envkey});
   42:                my $tstatus='is';
   43:                if ($tstart) {
   44:       		  if ($tstart>$then) { 
   45:                      $tstatus='future';
   46:                   }
   47:                }
   48:                if ($tend) {
   49:                   if ($tend<$then) { $tstatus='expired'; }
   50:                   if ($tend>$now) { $tstatus='will_not'; }
   51:                }
   52:                if ($tstatus eq 'is') {
   53:                    $where=~s/^\///;
   54:                    my ($cdom,$cnum,$csec)=split(/\//,$where);
   55:                    &Apache::lonnet::appenv('request.role' => $trolecode,
   56:                                            'request.sec'  => $csec);
   57:                    if ($cnum) {
   58: 		      &Apache::lonuserstate::readmap($cdom.'/'.$cnum);
   59:                       if ($ENV{'form.orgurl'}) {
   60:                          $r->internal_redirect($ENV{'form.orgurl'});
   61:                          return OK;
   62: 		      }
   63:                    }
   64:                }
   65:             } 
   66: 	  }
   67:         }
   68:     }
   69:         
   70: 
   71: # =============================================================== No Roles Init
   72: 
   73:     $r->content_type('text/html');
   74:     $r->send_http_header;
   75:     return OK if $r->header_only;
   76: 
   77:     $r->print(<<ENDHEADER);
   78: <html>
   79: <head>
   80: <title>LON-CAPA User Roles</title>
   81: </head><body bgcolor="#FFFFFF">
   82: ENDHEADER
   83: 
   84: # ------------------------------------------ Get Error Message from Environment
   85: 
   86:     my ($fn,$priv,$nochoose,$error,$msg)=split(/:/,$ENV{'user.error.msg'});
   87:     if ($ENV{'user.error.msg'}) {
   88:        $r->log_reason(
   89:      "$msg for $ENV{'user.name'} domain $ENV{'user.domain'} access $priv",$fn);
   90:     }
   91: 
   92: # ---------------------------------------------------------------- Who is this?
   93: 
   94:     my $advanced=0;
   95:     foreach $envkey (keys %ENV) {
   96:         if ($envkey=~/^user\.role\./) {
   97: 	    my ($dum1,$dum2,$role,@pwhere)=split(/\./,$envkey);
   98:             if ($role ne 'st') { $advanced=1; }
   99:         }
  100:     }
  101: 
  102: # ---------------------------------------------- Get cached course descriptions
  103: 
  104:     my %cdes=Apache::lonnet::dump('nohist_coursedescriptions');
  105: 
  106: # -------------------------------------------------------- Generate Page Output
  107: # --------------------------------------------------------------- Error Header?
  108:     if ($error) {
  109: 	$r->print("<h1>LON-CAPA Access Control</h1>");
  110:         $r->print("<hr><pre>Access  : ".
  111:                   Apache::lonnet::plaintext($priv)."\n");
  112:         $r->print("Resource: $fn\n");
  113:         $r->print("Action  : $msg\n</pre><hr>");
  114:     } else {
  115:         $r->print("<h1>LON-CAPA User Roles</h1>");
  116:     }
  117: # -------------------------------------------------------- Choice or no choice?
  118:     if ($nochoose) {
  119:         if ($advanced) {
  120: 	   $r->print("<h2>Assigned User Roles</h2>\n");
  121:         } else {
  122:            $r->print("<h2>Sorry ...</h2>\nThis resource might be part of");
  123:            if ($ENV{'request.course.id'}) {
  124: 	       $r->print(' another');
  125:            } else {
  126:                $r->print(' a certain');
  127:            } 
  128:            $r->print(' course.</body></html>');
  129:            return OK;
  130:         } 
  131:     } else {
  132:         if ($advanced) {
  133:            $r->print("<h2>Select a User Role</h2>\n");
  134:         } else {
  135: 	   $r->print("<h2>Enter a Course</h2>\n");
  136:         }
  137:         $r->print('<form method=post action="'.(($fn)?$fn:$r->uri).'">');
  138:         $r->print('<input type=hidden name=orgurl value="'.$fn.'">');
  139:         $r->print('<input type=hidden name=selectrole value=1>');
  140:     }
  141: # ----------------------------------------------------------------------- Table
  142:     $r->print('<table><tr>');
  143:     unless ($nochoose) { $r->print('<th>&nbsp;</th>'); }
  144:     if ($advanced) {
  145:        $r->print('<th>User Role</th><th colspan=2>Extent</th>'.
  146:                  '<th>Start</th><th>End</th><th>Remark</th></tr>'."\n");
  147:     } else {
  148: 	$r->print('<th>Course</th></tr>'."\n");
  149:     }
  150: 
  151:     foreach $envkey (sort keys %ENV) {
  152:         if ($envkey=~/^user\.role\./) {
  153: 	    my ($dum1,$dum2,$role,@pwhere)=split(/\./,$envkey);
  154:             my $where=join('.',@pwhere);
  155:             my $trolecode=$role.'.'.$where;
  156:             my ($tstart,$tend)=split(/\./,$ENV{$envkey});
  157:             my $tremark='';
  158:             my $tstatus='is';
  159:             my $tpstart='&nbsp;';
  160:             my $tpend='&nbsp;';
  161:             if ($tstart) {
  162: 		if ($tstart>$then) { 
  163:                    $tstatus='future';
  164:                    if ($tstart<$now) { $tstatus='will'; }
  165:                 }
  166:                 $tpstart=localtime($tstart);
  167:             }
  168:             if ($tend) {
  169:                 if ($tend<$then) { $tstatus='expired'; }
  170:                 if ($tend>$now) { $tstatus='will_not'; }
  171:                 $tpend=localtime($tend);
  172:             }
  173:             if ($ENV{'request.role'} eq $trolecode) {
  174: 		$tstatus='selected';
  175:             }
  176:             my $tbg;
  177:             if ($tstatus eq 'is') {
  178: 		$tbg='#77FF77';
  179:             } elsif ($tstatus eq 'future') {
  180:                 $tbg='#FFFF77';
  181:             } elsif ($tstatus eq 'will') {
  182:                 $tbg='#FFAA77';
  183:                 $tremark.='Active at next login. ';
  184:             } elsif ($tstatus eq 'expired') {
  185:                 $tbg='#FF7777';
  186: 	    } elsif ($tstatus eq 'will_not') {
  187:                 $tbg='#AAFF77';
  188:                 $tremark.='Expired after logout. ';
  189:             } elsif ($tstatus eq 'selected') {
  190:                 $tbg='#33FF33';
  191:                 $tremark.='Currently selected. ';
  192:             }
  193:             my $trole;
  194:             if ($role =~ /^cr\//) {
  195: 	       my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$role);
  196:                $tremark.='<br>Defined by '.$rauthor.' at '.$rdomain.'.';
  197:                $trole=$rrole;
  198: 	    } else {
  199:                $trole=Apache::lonnet::plaintext($role);
  200:             }
  201:             my $ttype;
  202:             my $twhere;
  203:             my ($tdom,$trest,$tsection)=
  204:                split(/\//,Apache::lonnet::declutter($where));
  205:             if ($trest) {
  206: 		$ttype='Course';
  207:                 if ($tsection) {
  208:                    $ttype.='<br>Section/Group: '.$tsection;
  209:                 }     
  210:                 my $tcourseid=$tdom.'/'.$trest;
  211:                 if ($cdes{$tcourseid}) {
  212: 		    $twhere=$cdes{$tcourseid};
  213:                 } else {
  214:                     my %newhash=Apache::lonnet::coursedescription($tcourseid);
  215:                     if (%newhash) {
  216: 			$twhere=$newhash{'description'};
  217:                     } else {
  218:                         $twhere='Currently not available';
  219:                     }
  220:                     $cdes{$tcourseid}=$twhere;
  221:                 }
  222:             } elsif ($tdom) {
  223:                 $ttype='Domain';
  224:                 $twhere=$tdom;
  225:             } else {
  226:                 $ttype='System';
  227:                 $twhere='system wide';
  228:             }
  229:                
  230:             $r->print('<tr bgcolor='.$tbg.'>');
  231:             unless ($nochoose) {
  232: 		if ($tstatus eq 'is') {
  233:                     $r->print('<td><input type=submit value=Select name="'.
  234:                               $trolecode.'"></td>');
  235:                 } else {
  236:                     $r->print('<td>&nbsp;</td>');
  237:                 }
  238:             }
  239:             $r->print('<td>'.$trole.'</td><td>'.
  240: 		      $ttype.'</td><td>'.$twhere.'</td><td>'.$tpstart.
  241:                       '</td><td>'.$tpend.
  242:                       '</td><td>'.$tremark.'&nbsp;</td></tr>'."\n");
  243:         }
  244:     }
  245: 
  246:     $r->print('</table>');
  247:     unless ($nochoose) {
  248: 	$r->print("</form>\n");
  249:     }
  250: # ------------------------------------------------------------ Priviledges Info
  251:   if ($advanced) {
  252:     $r->print('<hr><h2>Priviledges</h2>');
  253: 
  254:     foreach $envkey (sort keys %ENV) {
  255:         if ($envkey=~/^user\.priv\./) {
  256: 	    my ($dum1,$dum2,@pwhere)=split(/\./,$envkey);
  257:             my $where=join('.',@pwhere);
  258:             my $ttype;
  259:             my $twhere;
  260:             my ($tdom,$trest)=
  261:                split(/\//,Apache::lonnet::declutter($where));
  262:             if ($trest) {
  263: 		$ttype='Course';
  264:                 $twhere=$cdes{$tdom.'/'.$trest};
  265:             } elsif ($tdom) {
  266:                 $ttype='Domain';
  267:                 $twhere=$tdom;
  268:             } else {
  269:                 $ttype='System';
  270:                 $twhere='/';
  271:             }
  272:             $r->print("\n<h3>".$ttype.': '.$twhere.'</h3><ul>');
  273:             map {
  274:               if ($_) {
  275: 		  my ($prv,$restr)=split(/\&/,$_);
  276:                   my $trestr='';
  277:                   if ($restr ne 'F') {
  278:                       my $i;
  279:                       $trestr.=' (';
  280:                       for ($i=0;$i<length($restr);$i++) {
  281: 		         $trestr.=
  282:                            Apache::lonnet::plaintext(substr($restr,$i,1));
  283:                          if ($i<length($restr)-1) { $trestr.=', '; }
  284: 		      }
  285:                       $trestr.=')';
  286:                   }
  287:                   $r->print('<li>'.Apache::lonnet::plaintext($prv).$trestr.
  288:                             '</li>');
  289: 	      }
  290:             } sort split(/:/,$ENV{$envkey});
  291:             $r->print('</ul>');
  292:         }
  293:     }
  294:   }
  295: # -------------------------------------------------------------- Debug - remove
  296: 
  297:     $->print("<hr><h1>Debugging</h1><hr>\n");
  298:     
  299:     foreach $envkey (sort keys %ENV) {
  300: 	$r->print("$envkey ---- $ENV{$envkey}<br>");
  301:     }
  302: 
  303: # ------------------------------------------------------------------- End Debug
  304: 
  305:     $r->print("</body></html>\n");
  306:     return OK;
  307: } 
  308: 
  309: 1;
  310: __END__

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