File:  [LON-CAPA] / loncom / interface / lonsupportreq.pm
Revision 1.5.2.1: download - view: text, annotated - select for diffs
Wed Sep 22 19:13:41 2004 UTC (19 years, 8 months ago) by albertel
CVS tags: version_1_2_X, version_1_2_1
Diff to branchpoint 1.5: preferred, unified
 bacport 1.9

    1: package Apache::lonsupportreq;
    2: 
    3: use strict;
    4: use lib qw(/home/httpd/lib/perl);
    5: use MIME::Types;
    6: use MIME::Lite;
    7: use Apache::Constants qw(:common);
    8: use Apache::loncommon();
    9: use Apache::lonnet();
   10: use Apache::lonlocal;
   11: 
   12: sub handler {
   13:     my ($r) = @_;
   14:     &Apache::loncommon::content_type($r,'text/html');
   15:     $r->send_http_header;
   16: 
   17:     if ($r->header_only) {
   18:         return OK;
   19:     }
   20: 
   21:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['action','origurl','function']);
   22:     my $action = $ENV{'form.action'};
   23:     my $function = $ENV{'form.function'};
   24:     my $origurl = &Apache::lonnet::unescape($ENV{'form.origurl'});
   25:     if ($action eq 'process') {
   26:         &print_request_receipt($r,$origurl,$function);
   27:     } else {
   28:         &print_request_form($r,$origurl,$function);
   29:     }
   30:     return OK;
   31: }
   32:     
   33: sub print_request_form {
   34:     my ($r,$origurl,$function) = @_;
   35:     my ($os,$browser,$bversion,$uhost,$uname,$udom,$uhome,$urole,$usec,$email,$cid,$cdom,$cnum,$ctitle,$ccode,$sectionlist,$lastname,$firstname,$server);
   36:     my $bodytag = &Apache::loncommon::bodytag('',$function,'topmargin="0",marginheight="0"',1);
   37:     my $tablecolor = &Apache::loncommon::designparm($function.'.tabbg');
   38:     if (($tablecolor eq '') || ($tablecolor eq '#FFFFFF')) {
   39:         $tablecolor = '#CCCCFF';
   40:     }
   41:     $os = $ENV{'browser.os'};
   42:     $browser = $ENV{'browser.type'};
   43:     $bversion = $ENV{'browser.version'};
   44:     $uhost = $ENV{'request.host'};
   45:     $uname = $ENV{'user.name'};
   46:     $udom = $ENV{'user.domain'};
   47:     $uhome = $ENV{'user.home'};
   48:     $urole = $ENV{'request.role'};
   49:     $usec = $ENV{'request.course.sec'};
   50:     $cid = $ENV{'request.course.id'};
   51:     $server = $ENV{'SERVER_NAME'};
   52:     my $scripttag = (<<END);
   53: <script>
   54: function validate() {
   55:     if (document.logproblem.email.value.indexOf("\@") == -1) {
   56:         alert("You must enter a valid e-mail address");
   57:         return
   58:     }
   59:     document.logproblem.submit();
   60: }
   61: </script>
   62: END
   63:     if ($cid =~ m/_/) {
   64:         ($cdom,$cnum) = split/_/,$cid;
   65:     }
   66:     if ($cdom && $cnum) {
   67:         my %csettings = &Apache::lonnet::get('environment',['description','internal.coursecode','internal.sectionnums'],$cdom,$cnum);
   68:         $ctitle = $csettings{'description'};
   69:         $ccode = $csettings{'internal.coursecode'};
   70:         $sectionlist = $csettings{'internal.sectionnums'};
   71:     }
   72:     if ($ENV{'environment.critnotification'}) {
   73:         $email = $ENV{'environment.critnotification'};
   74:     }
   75:     if (!$email && $ENV{'environment.notification'}) {
   76:         $email = $ENV{'environment.notification'};
   77:     }
   78:     if ($ENV{'environment.lastname'}) {
   79:         $lastname = $ENV{'environment.lastname'};
   80:     }
   81:     if ($ENV{'environment.firstname'}) {
   82:         $firstname = $ENV{'environment.firstname'};
   83:     }
   84:     my @sections = split/,/,$sectionlist;
   85:     my %groupid = ();
   86:     foreach (@sections) {
   87:         my ($sec,$grp) = split/:/,$_;
   88:         $groupid{$sec} = $grp;
   89:     }
   90:     my $defdom = $Apache::lonnet::perlvar{'lonDefDomain'};
   91:     my $codedom = $defdom;
   92:     my %coursecodes = ();
   93:     my %codes = ();
   94:     my @codetitles = ();
   95:     my %cat_titles = ();
   96:     my %cat_order = ();
   97:     my $caller = 'global';
   98:     my $totcodes = 0;
   99:     my $format_reply;
  100:     
  101:     if ($cdom) {
  102:         $codedom = $cdom;
  103:     }
  104:     if ($cnum) {
  105:         $coursecodes{$cnum} = $ccode;
  106:         if ($ccode eq '') {
  107:             $totcodes = &retrieve_instcodes(\%coursecodes,$codedom,$totcodes);
  108:         } else {
  109:             $coursecodes{$cnum} = $ccode;
  110:             $caller = $cnum;
  111:             $totcodes ++;
  112:         }
  113:     } else { 
  114:         $totcodes = &retrieve_instcodes(\%coursecodes,$codedom,$totcodes);
  115:     }
  116:     if ($totcodes > 0) {
  117:         $format_reply = &Apache::lonnet::auto_instcode_format($caller,$codedom,\%coursecodes,\%codes,\@codetitles,\%cat_titles,\%cat_order);
  118:     }
  119:     $r->print(<<END);
  120: <html>
  121: <head>
  122:  <title>LON-CAPA support request</title>
  123: $scripttag
  124: </head>
  125: $bodytag
  126:  <table width="580" border="0" cellpadding="0" cellspacing="0" bgcolor="#000000">
  127:   <tr>
  128:    <td>
  129:     <table width="100%" border="0" cellpadding="0" cellspacing="1" bgcolor="#000000">
  130:      <tr>
  131:       <td>
  132:        <table width="100%" border="0" cellpadding="0" cellspacing="0" bgcolor="#ffffff">
  133:         <tr>
  134:          <td>
  135: 	  <table width="100%" border="0" cellpadding="0" cellspacing="1" bgcolor="#ffffff">
  136:            <form method="post" name="logproblem" enctype="multipart/form-data">
  137:            <tr>
  138:             <td width="140" bgcolor="$tablecolor">
  139:              <table width="140" border="0" cellpadding="8" cellspacing="0">
  140:               <tr>
  141:                <td align="right"><b>Name:</b>
  142:                </td>
  143:               </tr>
  144:              </table>
  145:             </td>
  146:             <td width="100%" valign="top">
  147:              <table width="100%" border="0" cellpadding="8" cellspacing="0">
  148:               <tr>
  149:                <td>
  150: END
  151:     my $fullname = '';
  152:     if ((defined($lastname) && $lastname ne '') && (defined($firstname) && $firstname ne '')) {
  153:         $fullname = "$firstname $lastname"; 
  154:         $r->print("$fullname<input type=\"hidden\" name=\"username\" value=\"$fullname\" />");
  155:     } else {
  156:         if (defined($firstname) && $firstname ne '') {
  157:             $fullname = $firstname;
  158:         } elsif (defined($lastname) && $lastname ne '') {
  159:             $fullname= " $lastname";
  160:         }
  161:         $r->print('<input type="text" size="20" name="username" value="'.$fullname.'" /><br />');
  162:     }
  163:     $r->print(<<END);
  164:                </td>
  165:               </tr>
  166:              </table>
  167:             </td>
  168:            </tr>
  169:            <tr>
  170:             <td width="100%" colspan="2" bgcolor="#000000">
  171:              <img src="/adm/lonMisc/blackdot.gif" /><br />
  172:             </td>
  173:            </tr>
  174:            <tr>
  175:             <td width="140" bgcolor="$tablecolor">
  176:              <table width="140" border="0" cellpadding="8" cellspacing="0">
  177:               <tr>
  178:                <td align="right"><b>E-mail address:</b>
  179:                </td>
  180:               </tr>
  181:              </table>
  182:             </td>
  183:             <td width="100%" valign="top">
  184:              <table width="100%" border="0" cellpadding="8" cellspacing="0">
  185:               <tr>
  186:                <td>
  187:                 <input type="text" size="20" name="email" value="$email" /><br />
  188:                </td>
  189:               </tr>
  190:              </table>
  191:             </td>
  192:            </tr>
  193:            <tr>
  194:             <td width="100%" colspan="2" bgcolor="#000000">
  195:              <img src="/adm/lonMisc/blackdot.gif" /><br />
  196:             </td>
  197:            </tr>
  198:            <tr>
  199:             <td width="140" bgcolor="$tablecolor">
  200:              <table width="140" border="0" cellpadding="8" cellspacing="0">
  201:               <tr>
  202:                <td align="right"><b>username/domain:</b>
  203:                </td>
  204:               </tr>
  205:              </table>
  206:             </td>
  207:             <td width="100%" valign="top">
  208:              <table width="100%" border="0" cellpadding="8" cellspacing="0">
  209:               <tr>
  210:                <td>
  211: END
  212:     my $udom_input = '<input type="hidden" name="udom" value="'.$udom.'" />';
  213:     my $uname_input = '<input type="hidden" name="uname" value="'.$uname.'" />'; 
  214:     if (defined($uname) && defined($udom)) {
  215:         $r->print('<i>username</i>:&nbsp;'.$uname.'&nbsp;&nbsp;<i>domain</i>:&nbsp;'.$udom.$udom_input.$uname_input);
  216:     } else {
  217:         my $udomform = '';
  218:         my $unameform = '';
  219:         if (defined($udom)) {
  220:             $udomform = '<i>domain</i>:&nbsp;'.$udom.$udom_input;
  221:         } elsif (defined($uname)) {
  222:             $unameform = '<i>username</i>:&nbsp;'.$uname.'&nbsp;&nbsp;'.$uname_input;
  223:         }
  224:         if ($udomform eq '') {
  225:             $udomform = '<i>domain</i>:&nbsp;';
  226:             $udomform .= &Apache::loncommon::select_dom_form('','udom');
  227:         }
  228:         if ($unameform eq '') {
  229:             $unameform= '<i>username</i>:&nbsp;<input type="text" size="20" name="loncname" value="'.$uname.'" />&nbsp;&nbsp;';
  230:         }
  231:         $r->print($unameform.$udomform.'<br />Enter the username you use to log-in to your LON-CAPA system, and choose your domain.');
  232:     }
  233:     $r->print(<<END);
  234:                </td>
  235:               </tr>
  236:              </table>
  237:             </td>
  238:            </tr>
  239:            <tr>
  240:             <td width="100%" colspan="2" bgcolor="#000000">
  241:              <img src="/adm/lonMisc/blackdot.gif" /><br />
  242:             </td>
  243:            </tr>
  244:            <tr>
  245:             <td width="140" bgcolor="$tablecolor">
  246:              <table width="140" border="0" cellpadding="8" cellspacing="0">
  247:               <tr>
  248:                <td align="right"><b>URL of page:</b>
  249:                </td>
  250:               </tr>
  251:              </table>
  252:             </td>
  253:             <td width="100%" valign="top">
  254:              <table width="100%" border="0" cellpadding="8" cellspacing="0">
  255:               <tr>
  256:                <td>
  257:                 http://$server$origurl<input type="hidden" name="origurl" value="http://$server$origurl" />
  258:                </td>
  259:               </tr>
  260:              </table>
  261:             </td>
  262:            </tr>
  263:            <tr>
  264:             <td width="100%" colspan="2" bgcolor="#000000">
  265:              <img src="/adm/lonMisc/blackdot.gif" /><br />
  266:             </td>
  267:            </tr>
  268:            <tr>
  269:             <td width="140" bgcolor="$tablecolor">
  270:              <table width="140" border="0" cellpadding="8" cellspacing="0">
  271:               <tr>
  272:                <td align="right"><b>Phone #:</b>
  273:                </td>
  274:               </tr>
  275:              </table>
  276:             </td>
  277:             <td width="100%" valign="top">
  278:              <table width="100%" border="0" cellpadding="8" cellspacing="0">
  279:               <tr>
  280:                <td>
  281:                 <input type="text" size="15" name="phone"><br>
  282:                </td>
  283:               </tr>
  284:              </table>
  285:             </td>
  286:            </tr>
  287:            <tr>
  288:             <td width="100%" colspan="2" bgcolor="#000000">
  289:              <img src="/adm/lonMisc/blackdot.gif" /><br />
  290:             </td>
  291:            </tr>
  292:            <tr>
  293:             <td width="140" bgcolor="$tablecolor">
  294:              <table width="140" border="0" cellpadding="8" cellspacing="0">
  295:               <tr>
  296:                <td align="right"><b>Course Details:</b>
  297:                </td>
  298:               </tr>
  299:              </table>
  300:             </td>
  301:             <td width="100%" valign="top">
  302:              <table border="0" cellpadding="3" cellspacing="3">
  303:               <tr>
  304:                <td>
  305: END
  306:     if ($coursecodes{$cnum}) {
  307:         foreach (@codetitles) {
  308:             $r->print('<i>'.$_.'</i>:&nbsp;'.$codes{$cnum}{$_}.';&nbsp;');
  309:         }
  310:         $r->print('&nbsp;<input type="hidden" name="coursecode" value="'.$coursecodes{$cnum}.'" />');
  311:     } else {
  312:         $r->print('Enter institutional course code:&nbsp;
  313:                   <input type="text" name="coursecode" size="15" value="" />');
  314:     }
  315:     if ($ctitle) {
  316:         $r->print('<br /><i>Title</i>:&nbsp;'.$ctitle.'<input type="hidden" name="title" value="'.$ctitle.'" />');
  317:     } else {
  318:         $r->print('<br />Enter course title:&nbsp;
  319:                  <input type="text" name="title" size="15" value="" />');
  320:     }
  321:     $r->print(<<END);
  322:                </td>
  323:               </tr>
  324:              </table>
  325:             </td>
  326:            </tr>
  327:            <tr>
  328:             <td width="100%" colspan="2" bgcolor="#000000">
  329:              <img src="/adm/lonMisc/blackdot.gif" /><br />
  330:             </td>
  331:            </tr>
  332:            <tr>
  333:             <td width="140" bgcolor="$tablecolor">
  334:              <table width="140" border="0" cellpadding="8" cellspacing="0">
  335:               <tr>
  336:                <td align="right"><b>Section Number: </b>
  337:                </td>
  338:               </tr>
  339:              </table>
  340:             </td>
  341:             <td width="100%" valign="top">
  342:              <table width="100%" border="0" cellpadding="8" cellspacing="0">
  343:               <tr>
  344:                <td>
  345: END
  346:     if ($sectionlist) {
  347:         $r->print("<select name=\"section\">");
  348:         foreach (sort keys %groupid) {
  349:             if ($_ eq $groupid{$_} || $groupid{$_} eq '') {
  350:                 $r->print("<option value=\"$_\" />$_");
  351:             } else {
  352:                 $r->print("<option value=\"$_\" />$_ - (LON-CAPA sec: $groupid{$_})");
  353:             }
  354:         }
  355:         $r->print("</select>");
  356:     } else {
  357:         $r->print("<input type=\"text\" name=\"section\" size=\"10\"/>");
  358:     }
  359:     $r->print(<<END);
  360:                </td>
  361:               </tr>
  362:              </table>
  363:             </td>
  364:            </tr>
  365:            <tr>
  366:             <td width="100%" colspan="2" bgcolor="#000000">
  367:              <img src="/adm/lonMisc/blackdot.gif" /><br />
  368:             </td>
  369:            </tr>
  370:            <tr>
  371:             <td width="140" bgcolor="$tablecolor">
  372:              <table width="140" border="0" cellpadding="8" cellspacing="0">
  373:               <tr>
  374:                <td align="right"><b>Subject</b>
  375:                </td>
  376:               </tr>
  377:              </table>
  378:             </td>
  379:             <td width="100%" valign="top">
  380:              <table width="100%" border="0" cellpadding="8" cellspacing="0">
  381:               <tr>
  382:                <td>
  383:                 <input type="text" size="40" name="subject">
  384:                </td>
  385:               </tr>
  386:              </table>
  387:             </td>
  388:            </tr>
  389:            <tr>
  390:             <td width="100%" colspan="2" bgcolor="#000000">
  391:              <img src="/adm/lonMisc/blackdot.gif" /><br />
  392:             </td>
  393:            </tr>
  394:            <tr>
  395:             <td width="140" bgcolor="$tablecolor">
  396:              <table width="140" border="0" cellpadding="8" cellspacing="0">
  397:               <tr>
  398:                <td align="right"><b>Detailed description:</b>
  399:                </td>
  400:               </tr>
  401:              </table>
  402:             </td>
  403:             <td width="100%" valign="top">
  404:              <table width="100%" border="0" cellpadding="8" cellspacing="0">
  405:               <tr>
  406:                <td>
  407:                 <textarea rows="10" cols="45" name="description" wrap="virtual"></textarea>
  408:                </td>
  409:               </tr>
  410:              </table>
  411:             </td>
  412:            </tr>
  413:            <tr>
  414: 	    <td width="100%" colspan="2" bgcolor="#000000">
  415:              <img src="/adm/lonMisc/blackdot.gif" /><br />
  416: 	    </td>
  417: 	   </tr>
  418: END
  419:     if (defined($ENV{'user.name'})) {
  420:         $r->print(<<END);
  421:            <tr>
  422:             <td width="140" bgcolor="$tablecolor">
  423:              <table width="140" border="0" cellpadding="8" cellspacing="0">
  424:               <tr>
  425:                <td align="right"><b>Optional file upload:</b>
  426:                </td>
  427:               </tr>
  428:              </table>
  429:             </td>
  430:             <td width="100%" valign="top">
  431:              <table width="100%" border="0" cellpadding="8" cellspacing="0">
  432:               <tr>
  433:                <td>
  434:                 <input type="file" name="screenshot" size="20" /><br />Upload a file (e.g., a screenshot) relevant to your support request (128 KB max. size).
  435:                </td>
  436:               </tr>
  437:              </table>
  438:             </td>
  439:            </tr>
  440:            <tr>
  441:             <td width="100%" colspan="2" bgcolor="#000000">
  442:              <img src="/adm/lonMisc/blackdot.gif" /><br />
  443:             </td>
  444:            </tr>
  445: END
  446:     }
  447:     $r->print(<<END);
  448:            <tr>
  449:             <td width="140" bgcolor="$tablecolor">
  450:              <table width="140" border="0" cellpadding="8" cellspacing="0">
  451:               <tr>
  452:                <td align="right"><b>Finish:</b>
  453:                </td>
  454:               </tr>
  455:              </table>
  456:             </td>
  457:             <td width="100%" valign="top">
  458:              <table border="0" cellpadding="8" cellspacing="0">
  459:               <tr>
  460:                <td>
  461:                 <input type="hidden" name="action" value="process" />
  462:                 <input type="button" value="Submit Request Form" onClick="validate()"/> &nbsp;
  463:                </td>
  464:                <td>&nbsp;</td>
  465:                <td>
  466:                 <input type="reset" value="Clear Form">
  467:                </td>
  468:               </tr>
  469:              </table>
  470:             </td>
  471:            </tr>
  472:           </table>
  473:          </td>
  474:         </tr>
  475:        </table>
  476:       </td>
  477:      </tr>
  478:     </table>
  479:    </td>
  480:   </tr>
  481:  </table>
  482: END
  483:     return;
  484: }
  485: 
  486: sub print_request_receipt {
  487:     my ($r,$url,$function) = @_;
  488:     my @envvars = ('lonID','HTTP_HOST','HTTP_USER_AGENT','REMOTE_ADDR','SERVER_ADDR','SERVER_NAME','browser.os','browser.type','browser.version','user.home','request.role');
  489:     my @loncvars = ('user.name','user.domain','request.course.sec','request.course.id');
  490: 
  491:     my $bodytag = &Apache::loncommon::bodytag('',$function,'topmargin="0" marginheight="0"',1);
  492:     my $admin = $Apache::lonnet::perlvar{'lonAdminMail'};
  493:     my $to =  $Apache::lonnet::perlvar{'lonSupportEMail'};
  494:     my $from = $admin;
  495:     my $reporttime = &Apache::lonlocal::locallocaltime(time);
  496:     my $fontcolor = &Apache::loncommon::designparm($function.'.font');
  497:     my $vlinkcolor = &Apache::loncommon::designparm($function.'.vlink');
  498:     my $tablecolor = &Apache::loncommon::designparm($function.'.tabbg');
  499:     my @formvars = ('username','email','uname','udom','origurl','phone','section','coursecode','title','subject','description','screenshot');
  500:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},\@formvars);
  501: 
  502:     my $supportmsg = qq|
  503: Name: $ENV{'form.username'}
  504: Email: $ENV{'form.email'}
  505: Username/domain: $ENV{'form.uname'} - $ENV{'form.udom'}
  506: Tel: $ENV{'form.phone'}
  507: Course Information: $ENV{'form.title'} - $ENV{'form.coursecode'} - section: $ENV{'form.section'}
  508: Subject: $ENV{'form.subject'}
  509: Description: $ENV{'form.description'}
  510: URL: $ENV{'form.origurl'}
  511: Date/Time: $reporttime
  512: 
  513:     |;
  514:     my $descrip = $ENV{'form.description'};
  515:     $descrip =~ s#\n#<br />#g;
  516:     my $displaymsg = qq|
  517: <font color="$fontcolor">Name:</font><font color="$vlinkcolor"> $ENV{'form.username'}</font><br />
  518: <font color="$fontcolor">Email: </font><font color="$vlinkcolor">$ENV{'form.email'}</font><br />
  519: <font color="$fontcolor">Username/domain: </font><font color="$vlinkcolor">$ENV{'form.uname'} - $ENV{'form.udom'}</font><br />
  520: <font color="$fontcolor">Tel: </font><font color="$vlinkcolor">$ENV{'form.phone'}</font><br />
  521: <font color="$fontcolor">Course Information: </font><font color="$vlinkcolor">$ENV{'form.title'} - $ENV{'form.coursecode'} - section: $ENV{'form.section'}</font><br />
  522: <font color="$fontcolor">Subject: </font><font color="$vlinkcolor">$ENV{'form.subject'}</font><br />
  523: <font color="$fontcolor">Description: </font><font color="$vlinkcolor">$descrip</font><br />
  524: <font color="$fontcolor">URL: </font><font color="$vlinkcolor">$ENV{'form.origurl'}</font><br />
  525: <font color="$fontcolor">Date/Time: </font><font color="$vlinkcolor">$reporttime</font><br />
  526:     |;
  527: 
  528:     if ($to =~ m/^[^\@]+\@[^\@]+$/) {
  529:         $r->print(<<END);
  530: <html>
  531: <head>
  532:  <title>LON-CAPA support request recorded</title>
  533: </head>
  534: $bodytag
  535:  <h3>A support request has been sent to $to</h3>
  536: END
  537:     } else { 
  538:         $to = $admin;
  539: 	if ($to =~ m/^[^\@]+\@[^\@]+$/) {
  540: 	    $r->print(<<END);
  541: <html>
  542: <head>
  543:  <title>LON-CAPA support request recorded</title>
  544: </head>
  545: $bodytag
  546:  <h3>A support request has been sent to $to</h3>
  547: END
  548:         } else {
  549: 	    $r->print(<<END);
  550: <html>
  551: <head>
  552:  <title>LON-CAPA support request recorded</title>
  553: </head>
  554: $bodytag
  555:  <h3>Warning: Problem with support e-mail address</h3>
  556: 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 <b>not</b> been sent to the LON-CAPA support staff or administrator at your institution. Instead a copy has been sent to the LON-CAPA support team at Michigan State University. 
  557: END
  558:             $to = 'helpdesk@lon-capa.org';
  559:     }
  560:     if (defined($ENV{'form.email'})) {
  561:         if ($ENV{'form.email'} =~ m/^[^\@]+\@[^\@]+$/) {
  562:             $from = $ENV{'form.email'};
  563:         }
  564:     }
  565: 
  566:     my $subject = $ENV{'form.subject'};
  567:     $subject =~ s#(`)#'#g;
  568:     $subject =~ s#\$#\(\$\)#g;
  569:     $supportmsg =~ s#(`)#'#g;
  570:     $supportmsg =~ s#\$#\(\$\)#g;
  571:     $displaymsg =~ s#(`)#'#g;
  572:     $displaymsg =~ s#\$#\(\$\)#g;
  573:     my $fname;
  574: 
  575:     my $attachmentpath = '';
  576:     my $attachmentsize = '';
  577:     if (defined($ENV{'user.name'})) {
  578:         if ($ENV{'form.screenshot.filename'}) {
  579:             $attachmentsize = length($ENV{'form.screenshot'});
  580:             if ($attachmentsize > 131072) {
  581:                 $displaymsg .= "<br />The uploaded screenshot file ($attachmentsize bytes) included with your request exceeded the maximum allowed size - 128 KB, and has therefore been discarded.";
  582:             } else {
  583:                 $attachmentpath=&Apache::lonnet::userfileupload('screenshot',undef,'helprequests');
  584:             }
  585:         }
  586:     }
  587: 
  588:     if ($attachmentpath =~ m-/([^/]+)$-) {
  589:         $fname = $1;
  590:         $displaymsg .= "<br />An uploaded screenshot file - $fname ($attachmentsize bytes) was included in the request sent by $ENV{'user.name'} from LON-CAPA domain: $ENV{'user.domain'}";
  591:         $supportmsg .= "\n";
  592:         foreach (@envvars) {
  593:             $supportmsg .= "$_: $ENV{$_}\n";
  594:         }
  595:     }
  596:  
  597:     my $msg = MIME::Lite->new(
  598:                  From    => $from,
  599:                  To      => $to,
  600:                  Subject => $subject,
  601:                  Type    =>'TEXT',
  602:                  Data    => $supportmsg,
  603:                  );
  604: 
  605:     if ($attachmentpath) {
  606:         my ($type, $encoding) = MIME::Types::by_suffix($attachmentpath);
  607:         $msg->attach(Type     => $type,
  608:                      Path     => $attachmentpath,
  609:                      Filename => $fname
  610:                      );
  611: 
  612:     } else {
  613:         my $envdata = '';
  614:         foreach (@envvars) {
  615:             $envdata .= "$_: $ENV{$_}\n";
  616:         }
  617:         foreach (@loncvars) {
  618:             $envdata .= "$_: $ENV{$_}\n";
  619:         }
  620:         $msg->attach(Type => 'TEXT',
  621:                      Data => $envdata);
  622:     }
  623: 
  624: ### Send it:
  625:     # ->send can cause an sh launch which can pass all of %ENV along
  626:     # which can be to large for /bin/sh's little mind
  627:     my %oldENV=%ENV;
  628:     undef(%ENV);
  629:     $msg->send('sendmail');
  630:     %ENV=%oldENV;
  631:     undef(%oldENV);
  632: 
  633:     if ($attachmentpath =~ m#$Apache::lonnet::perlvar{'lonDaemons'}/tmp/helprequests/(\d+)/[^/]+#) {
  634:         unlink($attachmentpath);
  635:     }
  636:     $r->print(qq|
  637:  <b>Your support request contained the following information</b>:<br /><br />
  638:  <table width="580" border="0" cellpadding="0" cellspacing="0" bgcolor="#000000">
  639:   <tr>
  640:    <td>
  641:     <table width="100%" border="0" cellpadding="0" cellspacing="1" bgcolor="#000000">
  642:      <tr>
  643:       <td>
  644:        <table width="100%" border="0" cellpadding="0" cellspacing="0" bgcolor="#ffffff">
  645:         <tr>
  646:          <td>
  647:           <table width="100%" border="0" cellpadding="0" cellspacing="1" bgcolor="#ffffff">
  648:            <tr>
  649:             <td width="140" bgcolor="$tablecolor">
  650:              <table width="140" border="0" cellpadding="8" cellspacing="0">
  651:               <tr>
  652:                <td align="right"><b>Information supplied</b>
  653:                </td>
  654:               </tr>
  655:              </table>
  656:             </td>
  657:             <td width="100%" valign="top">
  658:              <table width="100%" border="0" cellpadding="8" cellspacing="0">
  659:               <tr>
  660:                <td>$displaymsg</td>
  661:               </tr>
  662:              </table>
  663:             </td>
  664:            </tr>
  665:            <tr>
  666:             <td width="100%" colspan="2" bgcolor="#000000">
  667:              <img src="/adm/lonMisc/blackdot.gif" /><br />
  668:             </td>
  669:            </tr>
  670:            <tr>
  671:             <td width="140" bgcolor="$tablecolor">
  672:              <table width="140" border="0" cellpadding="8" cellspacing="0">
  673:               <tr>
  674:                <td align="right"><b>Additional information recorded</b>
  675:                </td>
  676:               </tr>
  677:              </table>
  678:             </td>
  679:             <td width="100%" valign="top">
  680:              <table width="100%" border="0" cellpadding="8" cellspacing="0">
  681:               <tr>
  682:                <td>
  683:     |);
  684:     foreach (@envvars) {
  685:         unless($ENV{$_} eq '') { 
  686:             $r->print("$_:&nbsp;<font color='$vlinkcolor'>$ENV{$_}</font>, ");
  687:         }
  688:     }
  689:     $r->print("
  690:                </td>
  691:               </tr>
  692:              </table>
  693:             </td>
  694:            </tr>
  695:           </table>
  696:          </td>
  697:         </tr>
  698:        </table>
  699:       </td>
  700:      </tr>
  701:     </table>
  702:    </td>
  703:   </tr>
  704:  </table>
  705:     ");
  706: }
  707: 
  708: sub retrieve_instcodes {
  709:     my ($coursecodes,$codedom,$totcodes) = @_;
  710:     my %courses = &Apache::lonnet::courseiddump($codedom,'.',1);
  711:     foreach my $course (keys %courses) {
  712:         if ($courses{$course} =~ m/^[^:]*:([^:]+)$/) {
  713:             $$coursecodes{$course} = &Apache::lonnet::unescape($1);
  714:             $totcodes ++;
  715:         }
  716:     }
  717:     return $totcodes;
  718: }
  719: 
  720: 1;

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