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

Annotation of loncom/interface/lonmydesk.pm, revision 1.2

1.1       www         1: # The LearningOnline Network
                      2: # My Desk
                      3: #
                      4: # (Internal Server Error Handler
                      5: #
                      6: # (Login Screen
                      7: # 5/21/99,5/22,5/25,5/26,5/31,6/2,6/10,7/12,7/14,
                      8: # 1/14/00,5/29,5/30,6/1,6/29,7/1,11/9 Gerd Kortemeyer)
                      9: #
                     10: # 3/1/1 Gerd Kortemeyer)
                     11: #
1.2     ! www        12: # 3/1,5/11,5/20 Gerd Kortemeyer
1.1       www        13: #
                     14: package Apache::lonmydesk;
                     15: 
                     16: use strict;
                     17: use Apache::Constants qw(:common);
1.2     ! www        18: use Apache::lonnet;
        !            19: use vars qw(@desklines $readdesk);
        !            20:  
1.1       www        21: sub handler {
                     22:     my $r = shift;
                     23:     $r->content_type('text/html');
                     24:     $r->send_http_header;
                     25:     return OK if $r->header_only;
                     26: 
                     27: # --------------------------------------------------- Print login screen header
1.2     ! www        28:     $r->print(<<ENDHEADER);
1.1       www        29: <html>
                     30: <head>
                     31: <title>The LearningOnline Network with CAPA</title>
                     32: </head>
                     33: <body bgcolor="#FFFFFF">
1.2     ! www        34: <img src="/adm/lonIcons/lonlogos.gif" align="right">
1.1       www        35: <h1>My Desk</h1>
1.2     ! www        36: ENDHEADER
        !            37: 
        !            38: # In a course
        !            39: 
        !            40:     unless ($ENV{'request.course.id'}) {
        !            41: 	$r->print('<h3>No specific course chosen</h3>');
        !            42:     }
        !            43: 
        !            44: # Advanced User?
        !            45: 
        !            46:     my $adv=0;
        !            47: 
        !            48:     map {
        !            49:         if ($_=~/user\.role\.(\w+)/) {
        !            50: 	    if ($1 ne 'st') { $adv=1; }
        !            51:         }
        !            52:     } keys %ENV;
        !            53:     
        !            54: # Print Options
        !            55: 
        !            56:     my $uname=$ENV{'user.name'};
        !            57:     my $udom=$ENV{'user.domain'};
        !            58: 
        !            59:     map {
        !            60:         my ($priv,$extent,$url,$text)=split(/\:/,$_);
        !            61:         if ($priv eq 'cat') {
        !            62:            if (($extent eq 'any')||($adv)) {
        !            63: 	       $r->print('<h1>'.$url.'</h1>');
        !            64:            } 
        !            65:         } else {
        !            66:             my $checkext;
        !            67:             if ($extent eq 'sys') {
        !            68: 		$checkext='/';
        !            69:             } elsif ($extent eq 'dom') {
        !            70:                 $checkext='/'.$udom.'/';
        !            71: 	    } else {
        !            72:                 $checkext=$ENV{'request.course.id'};
        !            73:             }
        !            74:             if ((&Apache::lonnet::allowed($priv,$checkext)) ||
        !            75:                 ($priv eq 'any')) {
        !            76: 		$url=~s/\$udom/$udom/g;
        !            77:                 $url=~s/\$uname/$uname/g;
        !            78:                 $r->print('<a href="'.$url.'">'.$text.'</a><br>');
        !            79:             }
        !            80:         }
        !            81:     } @desklines;
        !            82: 
        !            83:     $r->print('</body></html>');
1.1       www        84:     return OK;
                     85: } 
1.2     ! www        86: # ================================================================ Main Program
1.1       www        87: 
1.2     ! www        88: sub BEGIN {
        !            89: if ($readdesk ne 'done') {
        !            90:   {
        !            91:     my $config=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
        !            92:                                  '/mydesk.tab');
        !            93:     while (my $configline=<$config>) {
        !            94:        chomp($configline);
        !            95:        $desklines[$#desklines+1]=$configline;
        !            96:     }
        !            97:   }
        !            98: }
        !            99: }
1.1       www       100: 1;
                    101: __END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>