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

1.1       www         1: # The LearningOnline Network
                      2: # Feedback
                      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,2/3,2/5 Gerd Kortemeyer
1.1       www        13: #
                     14: package Apache::lonfeedback;
                     15: 
                     16: use strict;
                     17: use Apache::Constants qw(:common);
                     18: 
                     19: sub handler {
                     20:     my $r = shift;
                     21:     $r->content_type('text/html');
                     22:     $r->send_http_header;
                     23:     return OK if $r->header_only;
                     24: 
1.2     ! www        25:     my $feedurl=$ENV{'form.postdata'};
        !            26:     $feedurl=~s/^http\:\/\///;
        !            27:     $feedurl=~s/^$ENV{'SERVER_NAME'}//;
        !            28:     $feedurl=~s/^$ENV{'HTTP_HOST'}//;
        !            29: 
        !            30:     if (($feedurl=~/^\/res/) || ($ENV{'request.course.id'})) {
1.1       www        31: # --------------------------------------------------- Print login screen header
1.2     ! www        32:     unless ($ENV{'form.sendit'}) {
        !            33: 	my $options='';
        !            34:         if ($feedurl=~/^\/res/) {
        !            35:            $options= 
        !            36:  '<p><input type=checkbox name=author> Feedback to resource author';
        !            37:         }
        !            38: 	if ($ENV{'course.'.$ENV{'request.course.id'}.'.question.email'}) {
        !            39:            $options.=
        !            40:  '<br><input type=checkbox name=question> Question about resource content';
        !            41:         }
        !            42: 	if ($ENV{'course.'.$ENV{'request.course.id'}.'.comment.email'}) {
        !            43:            $options.=
        !            44:  '<br><input type=checkbox name=question> '.
        !            45:  'Question/Comment/Feedback about course content';
        !            46:         }
        !            47: 	if ($ENV{'course.'.$ENV{'request.course.id'}.'.policy.email'}) {
        !            48:            $options.=
        !            49:  '<br><input type=checkbox name=question> '.
        !            50:  'Question/Comment/Feedback about course policy';
        !            51:         }
        !            52:        $r->print(<<ENDDOCUMENT);
1.1       www        53: <html>
                     54: <head>
                     55: <title>The LearningOnline Network with CAPA</title>
                     56: </head>
                     57: <body bgcolor="#FFFFFF">
1.2     ! www        58: <img align=right src=/adm/lonIcons/lonlogos.gif>
1.1       www        59: <h1>Feedback</h1>
1.2     ! www        60: <h2><tt>$feedurl</tt></h2>
        !            61: <form action="/adm/feedback" method=post>
        !            62: <input type=hidden name=postdata value="$feedurl">
        !            63: Please check at least one of the following:
        !            64: $options<hr>
        !            65: My question/comment/feedback:<p>
        !            66: <textarea name=comment cols=60 rows=10>
        !            67: </textarea><p>
        !            68: <input type=submit name=sendit value="Send Feedback"></input>
        !            69: </form>
1.1       www        70: </body>
                     71: </html>
                     72: ENDDOCUMENT
1.2     ! www        73: } else {
        !            74:     my $symb=&Apache::lonnet::symbread($feedurl);
        !            75:     my $prevattempts='';
        !            76:     if ($symb) {
        !            77:        my $answer=&Apache::lonnet::reply(
        !            78:               "restore:".$ENV{'user.domain'}.':'.$ENV{'user.name'}.':'.
        !            79:               $ENV{'request.course.id'}.':'.
        !            80:               &Apache::lonnet::escape($symb),
        !            81:               $ENV{'user.home'});
        !            82:        my %returnhash=();
        !            83:        map {
        !            84: 	  my ($name,$value)=split(/\=/,$_);
        !            85:           $returnhash{&Apache::lonnet::unescape($name)}=
        !            86:                       &Apache::lonnet::unescape($value);
        !            87:        } split(/\&/,$answer);
        !            88:        my %lasthash=();
        !            89:        my $version;
        !            90:        for ($version=1;$version<=$returnhash{'version'};$version++) {
        !            91:           map {
        !            92:              $lasthash{$_}=$returnhash{$version.':'.$_};
        !            93:           } split(/\:/,$returnhash{$version.':keys'});
        !            94:        }
        !            95:        $prevattempts='<table border=2></tr><th>History</th>';
        !            96:        map {
        !            97:            $prevattempts.='<th>'.$_.'</th>';
        !            98:        } keys %lasthash;
        !            99:        for ($version=1;$version<=$returnhash{'version'};$version++) {
        !           100: 	   $prevattempts.='</tr><tr><th>Attempt '.$version.'</th>';
        !           101:            map {
        !           102:                $prevattempts.='<td>'.$returnhash{$version.':'.$_}.'</td>';   
        !           103: 	  } keys %lasthash;
        !           104:        }
        !           105:        $prevattempts.='</tr><tr><th>Current</th>';
        !           106:        map {
        !           107:            $prevattempts.='<td>'.$lasthash{$_}.'</td>';
        !           108:        } keys %lasthash;
        !           109:        $prevattempts.='</tr></table>';
        !           110:     }
        !           111:     my $usersaw=&Apache::lonnet::ssi($feedurl);
        !           112:     $usersaw=~s/\<body[^\>]*\>//gi;
        !           113:     $usersaw=~s/\<\/body\>//gi;
        !           114:     $usersaw=~s/\<html\>//gi;
        !           115:     $usersaw=~s/\<\/html\>//gi;
        !           116:     $usersaw=~s/\<head\>//gi;
        !           117:     $usersaw=~s/\<\/head\>//gi;
        !           118:     $usersaw=~s/action\s*\=/would_be_action\=/gi;
        !           119: # <meta HTTP-EQUIV="Refresh" CONTENT="1; url=$feedurl">
        !           120:     
        !           121:     print (<<ENDREDIR);
        !           122: <head><title>Feedback sent</title>
        !           123: </head>
        !           124: <html>
        !           125: <body bgcolor="#FFFFFF">
        !           126: <b>Feedback sent ...</b>
        !           127: $prevattempts
        !           128: <hr>
        !           129: $usersaw
        !           130: </body>
        !           131: </html>
        !           132: ENDREDIR
        !           133: }
        !           134: } else {
        !           135:     print (<<ENDNOREDIR);
        !           136: <head><title>Feedback not sent</title>
        !           137: <meta HTTP-EQUIV="Refresh" CONTENT="1; url=$feedurl">
        !           138: </head>
        !           139: <html>
        !           140: <body bgcolor="#FFFFFF">
        !           141: Sorry, no feedback possible on this resource  ...
        !           142: </body>
        !           143: </html>
        !           144: ENDNOREDIR
        !           145: }
1.1       www       146:     return OK;
                    147: } 
                    148: 
                    149: 1;
                    150: __END__
1.2     ! www       151: 
        !           152: 
        !           153: 

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