LON-CAPA support request

package Apache::lonsupportreq; use strict; use lib qw(/home/httpd/lib/perl); use Apache::Constants qw(:common); use Apache::loncommon(); use Apache::lonnet(); use localenroll; use Apache::lonlocal; use Mail::Send; # use MIME::Lite; # use MIME::Types; sub handler { my ($r) = @_; &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; if ($r->header_only) { return OK; } &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['action','origurl','function']); my $action = $ENV{'form.action'}; my $function = $ENV{'form.function'}; my $origurl = &Apache::lonnet::unescape($ENV{'form.origurl'}); if ($action eq 'process') { &print_request_receipt($r,$origurl,$function); } else { &print_request_form($r,$origurl,$function); } return OK; } sub print_request_form { my ($r,$origurl,$function) = @_; my ($os,$browser,$bversion,$uhost,$uname,$udom,$uhome,$urole,$usec,$email,$cid,$cdom,$cnum,$ctitle,$ccode,$sectionlist,$lastname,$firstname,$server); my $bodytag = &Apache::loncommon::bodytag('',$function,'topmargin="0",marginheight="0"',1); my $tablecolor = &Apache::loncommon::designparm($function.'.tabbg'); $os = $ENV{'browser.os'}; $browser = $ENV{'browser.type'}; $bversion = $ENV{'browser.version'}; $uhost = $ENV{'request.host'}; $uname = $ENV{'user.name'}; $udom = $ENV{'user.domain'}; $uhome = $ENV{'user.home'}; $urole = $ENV{'request.role'}; $usec = $ENV{'request.course.sec'}; $cid = $ENV{'request.course.id'}; $server = $ENV{'SERVER_NAME'}; my $scripttag; if ($cid =~ m/_/) { ($cdom,$cnum) = split/_/,$cid; } if ($cdom && $cnum) { my %csettings = &Apache::lonnet::get('environment',['description','internal.coursecode','internal.sectionnums'],$cdom,$cnum); $ctitle = $csettings{'description'}; $ccode = $csettings{'internal.coursecode'}; $sectionlist = $csettings{'internal.sectionnums'}; } if ($ENV{'environment.critnotification'}) { $email = $ENV{'environment.critnotification'}; } if (!$email && $ENV{'environment.notification'}) { $email = $ENV{'environment.notification'}; } if ($ENV{'environment.lastname'}) { $lastname = $ENV{'environment.lastname'}; } if ($ENV{'environment.firstname'}) { $firstname = $ENV{'environment.firstname'}; } my @sections = split/,/,$sectionlist; my %groupid = (); foreach (@sections) { my ($sec,$grp) = split/:/,$_; $groupid{$sec} = $grp; } $r->print(< LON-CAPA support request END my $defdom = $Apache::lonnet::perlvar{'lonDefDomain'}; my $codedom = $defdom; my %coursecodes = (); my %codes = (); my @codetitles = (); my %cat_titles = (); my %cat_order = (); my $caller = 'global'; my $totcodes = 0; my $format_reply; if ($cdom) { $codedom = $cdom; } if ($cnum) { $coursecodes{$cnum} = $ccode; if ($ccode eq '') { $totcodes = &retrieve_instcodes(\%coursecodes,$codedom,$totcodes); } else { $coursecodes{$cnum} = $ccode; $caller = $cnum; $totcodes ++; } } else { $totcodes = &retrieve_instcodes(\%coursecodes,$codedom,$totcodes); } if ($totcodes > 0) { $format_reply = &Apache::lonnet::auto_instcode_format($caller,$codedom,\%coursecodes,\%codes,\@codetitles,\%cat_titles,\%cat_order); } $r->print(< LON-CAPA support request $scripttag $bodytag

Name:

END my $fullname = ''; if ((defined($lastname) && $lastname ne '') && (defined($firstname) && $firstname ne '')) { $fullname = "$firstname $lastname"; $r->print("$fullname"); } else { if (defined($firstname) && $firstname ne '') { $fullname = $firstname; } elsif (defined($lastname) && $lastname ne '') { $fullname= " $lastname"; } $r->print('
'); } $r->print(<

E-mail address:

username/domain:

END my $udom_input = ''; my $uname_input = ''; if (defined($uname) && defined($udom)) { $r->print('username: '.$uname.' domain: '.$udom.$udom_input.$uname_input); } else { my $udomform = ''; my $unameform = ''; if (defined($udom)) { $udomform = 'domain: '.$udom.$udom_input; } elsif (defined($uname)) { $unameform = 'username: '.$uname.' '.$uname_input; } if ($udomform eq '') { $udomform = 'domain: '; $udomform .= &Apache::loncommon::select_dom_form('','udom'); } if ($unameform eq '') { $unameform= 'username: '; } $r->print($unameform.$udomform.'
Enter the username you use to log-in to your LON-CAPA system, and choose your domain.'); } $r->print(<

URL of page:

$server$origurl

Phone #:

Course Details:

END if ($coursecodes{$cnum}) { foreach (@codetitles) { $r->print(''.$_.': '.$codes{$cnum}{$_}); } $r->print('. '); } else { $r->print('Enter institutional course code: '); } if ($ctitle) { $r->print('
Title: '.$ctitle.''); } else { $r->print('
Enter course title: '); } $r->print(<

Section Number:

END if ($sectionlist) { $r->print(""); } else { $r->print(""); } $r->print(<

Subject

Detailed description:

Finish:

END # What do we know about this user? # foreach (sort keys %ENV) { # if ($_ =~ m/^browser/) { # $r->print("key is $_, value is $ENV{$_}"); # } elsif ($_ =~ m/^environment/) { # $r->print("key is $_, value is $ENV{$_}"); # } elsif ($_ =~ m/^request/) { # $r->print("key is $_, value is $ENV{$_}"); # } elsif ($_ =~ m/^user\.(domain|home|name)/) { # $r->print("key is $_, value is $ENV{$_}"); # } elsif ($_ =~ /^[A-Z]/) { # $r->print("key is $_, value is $ENV{$_}"); # } # } return } sub print_request_receipt { my ($r,$url,$function) = @_; my @envvars = ('lonID','HTTP_HOST','HTTP_USER_AGENT','REMOTE_ADDR','SERVER_ADDR','SERVER_NAME','browser.os','browser.type','browser.version','user.home','request.role'); my $bodytag = &Apache::loncommon::bodytag('',$function,'topmargin="0" marginheight="0"',1); my $to = $Apache::lonnet::perlvar{'lonSupportEMail'}; my $reporttime = &Apache::lonlocal::locallocaltime(time); my $fontcolor = &Apache::loncommon::designparm($function.'.font'); my $vlinkcolor = &Apache::loncommon::designparm($function.'.vlink'); my $tablecolor = &Apache::loncommon::designparm($function.'.tabbg'); my @formvars = ('username','email','uname','udom','origurl','phone','section','coursecode','title','subject','description'); &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},\@formvars); # if ($ENV{'request.course.fn'}) { # my $formdatafile = $ENV{'request.course.fn'}.'.formdata'; # if (-e $formdatafile) { # open(FILE,"<$formdatafile"); # my @buffer =; # close(FILE); # foreach (@buffer) { # print STDERR $_; # } # } # } my $supportmsg = qq| Name: $ENV{'form.username'} Email: $ENV{'form.email'} Username/domain: $ENV{'form.uname'} - $ENV{'form.udom'} Tel: $ENV{'form.phone'} Course Information: $ENV{'form.title'} - $ENV{'form.coursecode'} - section: $ENV{'form.section'} Subject: $ENV{'form.subject'} Description: $ENV{'form.description'} URL: $ENV{'form.origurl'} Date/Time: $reporttime |; if ($to =~ m/^[^\@]+\@[^\@]+$/) { $r->print(< LON-CAPA support request recorded $bodytag

A support request has been sent to $to

END } else { $to = 'helpdesk@lon-capa.org'; $r->print(< LON-CAPA support request recorded $bodytag

Warning: Problem with support e-mail address

As the e-mail address provided for this LON-CAPA server ($to) does not appear to be a valid e-mail address, your support request has not been sent to the LON-CAPA support staff at your institution. Instead a copy has been sent to the LON-CAPA support team at Michigan State University. END } my $msg = new Mail::Send; $msg->to($to); # if (defined($ENV{'form.email'})) { # if ($ENV{'form.email'} =~ m/^[^\@]+\@[^\@]+$/) { # $msg->from($ENV{'form.email'}); # } # } $msg->subject('[LON-CAPA] - support request'); if (my $fh = $msg->open()) { print $fh $supportmsg; $fh->close; } $r->print(<Your support request contained the following information:

Information supplied

END my @textmsg = split/\n/,$supportmsg; foreach my $line (@textmsg) { $line =~ s|^||; $line =~ s|:|:|; $r->print("$line
"); } $r->print('

Additional information recorded

'); foreach (@envvars) { $r->print("$_: