Annotation of loncom/interface/lonsupportreq.pm, revision 1.5

1.1       raeburn     1: package Apache::lonsupportreq;
                      2: 
                      3: use strict;
                      4: use lib qw(/home/httpd/lib/perl);
1.5     ! raeburn     5: use MIME::Types;
        !             6: use MIME::Lite;
1.1       raeburn     7: use Apache::Constants qw(:common);
1.2       albertel    8: use Apache::loncommon();
                      9: use Apache::lonnet();
1.1       raeburn    10: use Apache::lonlocal;
                     11: 
                     12: sub handler {
1.2       albertel   13:     my ($r) = @_;
                     14:     &Apache::loncommon::content_type($r,'text/html');
1.1       raeburn    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');
1.5     ! raeburn    38:     if (($tablecolor eq '') || ($tablecolor eq '#FFFFFF')) {
        !            39:         $tablecolor = '#CCCCFF';
        !            40:     }
1.1       raeburn    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'};
1.5     ! raeburn    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
1.1       raeburn    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">
1.5     ! raeburn   136:            <form method="post" name="logproblem" enctype="multipart/form-data">
1.1       raeburn   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">
1.3       albertel  171:              <img src="/adm/lonMisc/blackdot.gif" /><br />
1.1       raeburn   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">
1.3       albertel  195:              <img src="/adm/lonMisc/blackdot.gif" /><br />
1.1       raeburn   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">
1.3       albertel  241:              <img src="/adm/lonMisc/blackdot.gif" /><br />
1.1       raeburn   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>
1.5     ! raeburn   257:                 http://$server$origurl<input type="hidden" name="origurl" value="http://$server$origurl" />
1.1       raeburn   258:                </td>
                    259:               </tr>
                    260:              </table>
                    261:             </td>
                    262:            </tr>
                    263:            <tr>
                    264:             <td width="100%" colspan="2" bgcolor="#000000">
1.3       albertel  265:              <img src="/adm/lonMisc/blackdot.gif" /><br />
1.1       raeburn   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">
1.3       albertel  289:              <img src="/adm/lonMisc/blackdot.gif" /><br />
1.1       raeburn   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) {
1.5     ! raeburn   308:             $r->print('<i>'.$_.'</i>:&nbsp;'.$codes{$cnum}{$_}.';&nbsp;');
1.1       raeburn   309:         }
1.5     ! raeburn   310:         $r->print('&nbsp;<input type="hidden" name="coursecode" value="'.$coursecodes{$cnum}.'" />');
1.1       raeburn   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">
1.3       albertel  329:              <img src="/adm/lonMisc/blackdot.gif" /><br />
1.1       raeburn   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 {
1.5     ! raeburn   352:                 $r->print("<option value=\"$_\" />$_ - (LON-CAPA sec: $groupid{$_})");
1.1       raeburn   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">
1.3       albertel  367:              <img src="/adm/lonMisc/blackdot.gif" /><br />
1.1       raeburn   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">
1.3       albertel  391:              <img src="/adm/lonMisc/blackdot.gif" /><br />
1.1       raeburn   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">
1.3       albertel  415:              <img src="/adm/lonMisc/blackdot.gif" /><br />
1.1       raeburn   416: 	    </td>
                    417: 	   </tr>
1.5     ! raeburn   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);
1.1       raeburn   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" />
1.5     ! raeburn   462:                 <input type="button" value="Submit Request Form" onClick="validate()"/> &nbsp;
1.1       raeburn   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
1.5     ! raeburn   483:     return;
1.1       raeburn   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');
1.5     ! raeburn   489:     my @loncvars = ('user.name','user.domain','request.course.sec','request.course.id');
        !           490: 
1.1       raeburn   491:     my $bodytag = &Apache::loncommon::bodytag('',$function,'topmargin="0" marginheight="0"',1);
1.5     ! raeburn   492:     my $admin = $Apache::lonnet::perlvar{'lonAdminMail'};
1.1       raeburn   493:     my $to =  $Apache::lonnet::perlvar{'lonSupportEMail'};
1.5     ! raeburn   494:     my $from = $admin;
1.1       raeburn   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');
1.5     ! raeburn   499:     my @formvars = ('username','email','uname','udom','origurl','phone','section','coursecode','title','subject','description','screenshot');
1.1       raeburn   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:     |;
1.5     ! raeburn   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: 
1.1       raeburn   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 = 'helpdesk@lon-capa.org';
                    539:         $r->print(<<END);
                    540: <html>
                    541: <head>
                    542:  <title>LON-CAPA support request recorded</title>
                    543: </head>
                    544: $bodytag
                    545:  <h3>Warning: Problem with support e-mail address</h3>
1.5     ! raeburn   546: 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 at your institution. Instead a copy has been sent to the LON-CAPA support team at Michigan State University. 
1.1       raeburn   547: END
                    548:     }
1.5     ! raeburn   549:     if (defined($ENV{'form.email'})) {
        !           550:         if ($ENV{'form.email'} =~ m/^[^\@]+\@[^\@]+$/) {
        !           551:             $from = $ENV{'form.email'};
        !           552:         }
        !           553:     }
        !           554: 
        !           555:     my $subject = $ENV{'form.subject'};
        !           556:     $subject =~ s#(`)#'#g;
        !           557:     $subject =~ s#\$#\(\$\)#g;
        !           558:     $supportmsg =~ s#(`)#'#g;
        !           559:     $supportmsg =~ s#\$#\(\$\)#g;
        !           560:     $displaymsg =~ s#(`)#'#g;
        !           561:     $displaymsg =~ s#\$#\(\$\)#g;
        !           562:     my $fname;
        !           563: 
        !           564:     my $attachmentpath = '';
        !           565:     my $attachmentsize = '';
        !           566:     if (defined($ENV{'user.name'})) {
        !           567:         if ($ENV{'form.screenshot.filename'}) {
        !           568:             $attachmentsize = length($ENV{'form.screenshot'});
        !           569:             if ($attachmentsize > 131072) {
        !           570:                 $displaymsg .= "<br />The uploaded screenshot file ($attachmentsize bytes) included with your request exceeded the maximum allowed size - 128 KB, and has therefore been discarded.";
        !           571:             } else {
        !           572:                 $attachmentpath=&Apache::lonnet::userfileupload('screenshot',undef,'helprequests');
        !           573:             }
        !           574:         }
        !           575:     }
        !           576: 
        !           577:     if ($attachmentpath =~ m-/([^/]+)$-) {
        !           578:         $fname = $1;
        !           579:         $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'}";
        !           580:         $supportmsg .= "\n";
        !           581:         foreach (@envvars) {
        !           582:             $supportmsg .= "$_: $ENV{$_}\n";
        !           583:         }
        !           584:     }
        !           585:  
        !           586:     my $msg = MIME::Lite->new(
        !           587:                  From    => $from,
        !           588:                  To      => $to,
        !           589:                  Subject => $subject,
        !           590:                  Type    =>'TEXT',
        !           591:                  Data    => $supportmsg,
        !           592:                  );
        !           593: 
        !           594:     if ($attachmentpath) {
        !           595:         my ($type, $encoding) = MIME::Types::by_suffix($attachmentpath);
        !           596:         $msg->attach(Type     => $type,
        !           597:                      Path     => $attachmentpath,
        !           598:                      Filename => $fname
        !           599:                      );
        !           600: 
        !           601:     } else {
        !           602:         my $envdata = '';
        !           603:         foreach (@envvars) {
        !           604:             $envdata .= "$_: $ENV{$_}\n";
        !           605:         }
        !           606:         foreach (@loncvars) {
        !           607:             $envdata .= "$_: $ENV{$_}\n";
        !           608:         }
        !           609:         $msg->attach(Type => 'TEXT',
        !           610:                      Data => $envdata);
        !           611:     }
        !           612: 
        !           613: ### Send it:
        !           614:     # ->send can cause an sh launch which can pass all of %ENV along
1.4       albertel  615:     # which can be to large for /bin/sh's little mind
                    616:     my %oldENV=%ENV;
                    617:     undef(%ENV);
1.5     ! raeburn   618:     $msg->send('sendmail');
1.4       albertel  619:     %ENV=%oldENV;
                    620:     undef(%oldENV);
1.5     ! raeburn   621: 
        !           622:     if ($attachmentpath =~ m#$Apache::lonnet::perlvar{'lonDaemons'}/tmp/helprequests/(\d+)/[^/]+#) {
        !           623:         unlink($attachmentpath);
        !           624:     }
        !           625:     $r->print(qq|
1.1       raeburn   626:  <b>Your support request contained the following information</b>:<br /><br />
                    627:  <table width="580" border="0" cellpadding="0" cellspacing="0" bgcolor="#000000">
                    628:   <tr>
                    629:    <td>
                    630:     <table width="100%" border="0" cellpadding="0" cellspacing="1" bgcolor="#000000">
                    631:      <tr>
                    632:       <td>
                    633:        <table width="100%" border="0" cellpadding="0" cellspacing="0" bgcolor="#ffffff">
                    634:         <tr>
                    635:          <td>
                    636:           <table width="100%" border="0" cellpadding="0" cellspacing="1" bgcolor="#ffffff">
                    637:            <tr>
                    638:             <td width="140" bgcolor="$tablecolor">
                    639:              <table width="140" border="0" cellpadding="8" cellspacing="0">
                    640:               <tr>
                    641:                <td align="right"><b>Information supplied</b>
                    642:                </td>
                    643:               </tr>
                    644:              </table>
                    645:             </td>
                    646:             <td width="100%" valign="top">
                    647:              <table width="100%" border="0" cellpadding="8" cellspacing="0">
                    648:               <tr>
1.5     ! raeburn   649:                <td>$displaymsg</td>
1.1       raeburn   650:               </tr>
                    651:              </table>
                    652:             </td>
                    653:            </tr>
                    654:            <tr>
1.5     ! raeburn   655:             <td width="100%" colspan="2" bgcolor="#000000">
        !           656:              <img src="/adm/lonMisc/blackdot.gif" /><br />
        !           657:             </td>
        !           658:            </tr>
        !           659:            <tr>
        !           660:             <td width="140" bgcolor="$tablecolor">
        !           661:              <table width="140" border="0" cellpadding="8" cellspacing="0">
1.1       raeburn   662:               <tr>
                    663:                <td align="right"><b>Additional information recorded</b>
                    664:                </td>
                    665:               </tr>
                    666:              </table>
                    667:             </td>
                    668:             <td width="100%" valign="top">
                    669:              <table width="100%" border="0" cellpadding="8" cellspacing="0">
                    670:               <tr>
                    671:                <td>
1.5     ! raeburn   672:     |);
1.1       raeburn   673:     foreach (@envvars) {
1.5     ! raeburn   674:         unless($ENV{$_} eq '') { 
        !           675:             $r->print("$_:&nbsp;<font color='$vlinkcolor'>$ENV{$_}</font>, ");
        !           676:         }
1.1       raeburn   677:     }
                    678:     $r->print("
                    679:                </td>
                    680:               </tr>
                    681:              </table>
                    682:             </td>
                    683:            </tr>
                    684:           </table>
                    685:          </td>
                    686:         </tr>
                    687:        </table>
                    688:       </td>
                    689:      </tr>
                    690:     </table>
                    691:    </td>
                    692:   </tr>
                    693:  </table>
                    694:     ");
                    695: }
                    696: 
                    697: sub retrieve_instcodes {
                    698:     my ($coursecodes,$codedom,$totcodes) = @_;
                    699:     my %courses = &Apache::lonnet::courseiddump($codedom,'.',1);
                    700:     foreach my $course (keys %courses) {
                    701:         if ($courses{$course} =~ m/^[^:]*:([^:]+)$/) {
                    702:             $$coursecodes{$course} = &Apache::lonnet::unescape($1);
                    703:             $totcodes ++;
                    704:         }
                    705:     }
                    706:     return $totcodes;
                    707: }
                    708: 
                    709: 1;

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