Annotation of loncom/auth/lonroles.pm, revision 1.2

1.1       harris41    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)
1.2     ! www         7: # 1/14,03/06,06/01 Gerd Kortemeyer
1.1       harris41    8: #
                      9: package Apache::lonroles;
                     10: 
                     11: use strict;
                     12: use Apache::lonnet();
                     13: use Apache::Constants qw(:common);
1.2     ! www        14: use Apache::File();
1.1       harris41   15: 
                     16: sub handler {
                     17:     my $r = shift;
                     18:     $r->content_type('text/html');
                     19:     $r->send_http_header;
                     20:     return OK if $r->header_only;
                     21: 
1.2     ! www        22: # --------------------------------------------------- Read Plain Text for Roles
        !            23: 
1.1       harris41   24:     my $tabdir  = $r->dir_config('lonTabDir');
                     25: 
1.2     ! www        26:     my @rolesplain;
        !            27:     my %plain;
        !            28: 
        !            29:     {
        !            30:        my $idf=Apache::File->new("$tabdir/rolesplain.tab");
        !            31:        @rolesplain=<$idf>;
        !            32:     }
        !            33:     map {
        !            34:         my ($short,$long)=split(/:/,$_);
        !            35:         $plain{$short}=$long;
        !            36:     } @rolesplain;
        !            37: 
1.1       harris41   38: # ---------------------------------------------------------------- Print Header
                     39:     $r->print(<<ENDHEADER);
                     40: <html>
                     41: <head>
                     42: <title>LON-CAPA User Roles</title>
                     43: </head>
                     44: <body bgcolor="#FFFFFF">
                     45: ENDHEADER
                     46: 
1.2     ! www        47: # ------------------------------------------ Get Error Message from Environment
        !            48: 
        !            49:     my ($fn,$priv,$nochoose,$error,$msg)=split(/:/,$ENV{'user.error.msg'});
1.1       harris41   50: 
1.2     ! www        51: # -------------------------------------------------------- Generate Page Output
        !            52: 
        !            53:     if ($error) {
        !            54: 	$r->print("<h1>LON-CAPA Access Control</h1>");
        !            55:         $r->print("<hr><pre>Access  : $plain{$priv}<br>");
        !            56:         $r->print("Resource: $fn<br>");
        !            57:         $r->print("Action  : $msg</pre><hr>");
        !            58:         $r->log_reason(
        !            59:  "$msg for $ENV{'user.name'} domain $ENV{'user.domain'} access $priv",$fn);
        !            60:     } else {
        !            61:         $r->print("<h1>LON-CAPA User Roles</h1>");
        !            62:     }
        !            63: 
        !            64:     if ($nochoose) {
        !            65: 	$r->print("<h2>Assigned User Roles</h2>");
        !            66:     } else {
        !            67:         $r->print("<h2>Select a User Role</h2>\n");
        !            68:         $r->print('<form method=get action="'.$fn.'">');
        !            69: $r->print('<input type=hidden name=blue value=green><input type=submit></form>');
        !            70:     }
1.1       harris41   71:     my $envkey;
1.2     ! www        72:     foreach $envkey (keys %ENV) {
        !            73: 	$r->print("$envkey ---- $ENV{$envkey}<br>");
        !            74:         if ($envkey=~/^user\.role\./) {
        !            75: 	    my ($dum1,$dum2,$role,$where)=split(/\./,$envkey);
        !            76:             $r->print("$plain{$role} for $where<br>");
        !            77:         }
1.1       harris41   78:     }
1.2     ! www        79: 
1.1       harris41   80:     $r->print("</body></html>\n");
                     81:     return OK;
                     82: } 
                     83: 
                     84: 1;
                     85: __END__

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