File:  [LON-CAPA] / loncom / interface / lonhtmlcommon.pm
Revision 1.21: download - view: text, annotated - select for diffs
Mon May 12 22:04:41 2003 UTC (21 years, 1 month ago) by matthew
Branches: MAIN
CVS tags: HEAD
Removed &MapOptions, &ProblemOptions, &PartOptions
&StatusOptions now takes a 'size' parameter (1 by default).
   Changed the text from 'Active', 'Expired', and 'Any' to
   "Currently Enrolled", "Previously Enrolled", and
   "Any Enrollment Status".  These changes should be transparent to any
   modules which currently use this subroutine.

    1: # The LearningOnline Network with CAPA
    2: # a pile of common html routines
    3: #
    4: # $Id: lonhtmlcommon.pm,v 1.21 2003/05/12 22:04:41 matthew Exp $
    5: #
    6: # Copyright Michigan State University Board of Trustees
    7: #
    8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
    9: #
   10: # LON-CAPA is free software; you can redistribute it and/or modify
   11: # it under the terms of the GNU General Public License as published by
   12: # the Free Software Foundation; either version 2 of the License, or
   13: # (at your option) any later version.
   14: #
   15: # LON-CAPA is distributed in the hope that it will be useful,
   16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   18: # GNU General Public License for more details.
   19: #
   20: # You should have received a copy of the GNU General Public License
   21: # along with LON-CAPA; if not, write to the Free Software
   22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   23: #
   24: # /home/httpd/html/adm/gpl.txt
   25: #
   26: # http://www.lon-capa.org/
   27: #
   28: ######################################################################
   29: ######################################################################
   30: 
   31: =pod
   32: 
   33: =head1 NAME
   34: 
   35: Apache::lonhtmlcommon - routines to do common html things
   36: 
   37: =head1 SYNOPSIS
   38: 
   39: Referenced by other mod_perl Apache modules.
   40: 
   41: =head1 INTRODUCTION
   42: 
   43: lonhtmlcommon is a collection of subroutines used to present information
   44: in a consistent html format, or provide other functionality related to
   45: html.
   46: 
   47: =head2 General Subroutines
   48: 
   49: =over 4
   50: 
   51: =cut 
   52: 
   53: ######################################################################
   54: ######################################################################
   55: 
   56: package Apache::lonhtmlcommon;
   57: 
   58: use Time::Local;
   59: use strict;
   60: 
   61: ##############################################
   62: ##############################################
   63: 
   64: =pod
   65: 
   66: =item &date_setter
   67: 
   68: Inputs
   69: 
   70: =over 4
   71: 
   72: =item $dname 
   73: 
   74: The name to prepend to the form elements.  
   75: The form elements defined will be dname_year, dname_month, dname_day,
   76: dname_hour, dname_min, and dname_sec.
   77: 
   78: =item $currentvalue
   79: 
   80: The current setting for this time parameter.  A unix format time
   81: (time in seconds since the beginning of Jan 1st, 1970, GMT.  
   82: An undefined value is taken to indicate the value is the current time.
   83: Also, to be explicit, a value of 'now' also indicates the current time.
   84: 
   85: =cut
   86: 
   87: ##############################################
   88: ##############################################
   89: sub date_setter {
   90:     my ($formname,$dname,$currentvalue) = @_;
   91:     if (! defined($currentvalue) || $currentvalue eq 'now') {
   92:         $currentvalue = time;
   93:     }
   94:     # other potentially useful values:     wkday,yrday,is_daylight_savings
   95:     my ($sec,$min,$hour,$mday,$month,$year,undef,undef,undef) = 
   96:         localtime($currentvalue);
   97:     $year += 1900;
   98:     my $result = "\n<!-- $dname date setting form -->\n";
   99:     $result .= <<ENDJS;
  100: <script language="Javascript">
  101:     function $dname\_checkday() {
  102:         var day   = document.$formname.$dname\_day.value;
  103:         var month = document.$formname.$dname\_month.value;
  104:         var year  = document.$formname.$dname\_year.value;
  105:         var valid = true;
  106:         if (day < 1) {
  107:             document.$formname.$dname\_day.value = 1;
  108:         } 
  109:         if (day > 31) {
  110:             document.$formname.$dname\_day.value = 31;
  111:         }
  112:         if ((month == 1)  || (month == 3)  || (month == 5)  ||
  113:             (month == 7)  || (month == 8)  || (month == 10) ||
  114:             (month == 12)) {
  115:             if (day > 31) {
  116:                 document.$formname.$dname\_day.value = 31;
  117:                 day = 31;
  118:             }
  119:         } else if (month == 2 ) {
  120:             if ((year % 4 == 0) && (year % 100 != 0)) {
  121:                 if (day > 29) {
  122:                     document.$formname.$dname\_day.value = 29;
  123:                 }
  124:             } else if (day > 29) {
  125:                 document.$formname.$dname\_day.value = 28;
  126:             }
  127:         } else if (day > 30) {
  128:             document.$formname.$dname\_day.value = 30;
  129:         }
  130:     }
  131: </script>
  132: ENDJS
  133:     $result .= "  <select name=\"$dname\_month\" ".
  134:         "onChange=\"javascript:$dname\_checkday()\" >\n";
  135:     my @Months = qw/January February  March     April   May      June 
  136:                     July    August    September October November December/;
  137:     # Pad @Months with a bogus value to make indexing easier
  138:     unshift(@Months,'If you can read this an error occurred');
  139:     for(my $m = 1;$m <=$#Months;$m++) {
  140:         $result .= "      <option value=\"$m\" ";
  141:         $result .= "selected " if ($m-1 == $month);
  142:         $result .= "> $Months[$m] </option>\n";
  143:     }
  144:     $result .= "  </select>\n";
  145:     $result .= "  <input type=\"text\" name=\"$dname\_day\" ".
  146:             "value=\"$mday\" size=\"3\" ".
  147:             "onChange=\"javascript:$dname\_checkday()\" />\n";
  148:     $result .= "  <input type=\"year\" name=\"$dname\_year\" ".
  149:             "value=\"$year\" size=\"5\" ".
  150:             "onChange=\"javascript:$dname\_checkday()\" />\n";
  151:     $result .= "&nbsp;&nbsp;";
  152:     $result .= "  <select name=\"$dname\_hour\" >\n";
  153:     for (my $h = 0;$h<24;$h++) {
  154:         $result .= "      <option value=\"$h\" ";
  155:         $result .= "selected " if ($hour == $h);
  156:         $result .= "> ";
  157:         if ($h == 0) {
  158:             $result .= "12 am";
  159:         } elsif($h == 12) {
  160:             $result .= "12 noon";
  161:         } elsif($h < 12) {
  162:             $result .= "$h am";
  163:         } else {
  164:             $result .= $h-12 ." pm";
  165:         }
  166:         $result .= " </option>\n";
  167:     } 
  168:     $result .= "  </select>\n";
  169:     $result .= "  <input type=\"text\" name=\"$dname\_minute\" ".
  170:         "value=\"$min\" size=\"3\" /> m\n";
  171:     $result .= "  <input type=\"text\" name=\"$dname\_second\" ".
  172:         "value=\"$sec\" size=\"3\" /> s\n";
  173:     $result .= "<!-- end $dname date setting form -->\n";
  174:     return $result;
  175: }
  176: 
  177: ##############################################
  178: ##############################################
  179: 
  180: =item &get_date_from_form
  181: 
  182: Inputs:
  183: 
  184: =over 4
  185: 
  186: =item $dname
  187: 
  188: The name passed to &datesetter, which prefixes the form elements.
  189: 
  190: =item $defaulttime
  191: 
  192: The unix time to use as the default in case of poor inputs.
  193: 
  194: =back
  195: 
  196: Returns: Unix time represented in the form.
  197: 
  198: =cut
  199: 
  200: ##############################################
  201: ##############################################
  202: sub get_date_from_form {
  203:     my ($dname) = @_;
  204:     my ($sec,$min,$hour,$day,$month,$year);
  205:     #
  206:     if (defined($ENV{'form.'.$dname.'_second'})) {
  207:         my $tmpsec = $ENV{'form.'.$dname.'_second'};
  208:         if (($tmpsec =~ /^\d+$/) && ($tmpsec >= 0) && ($tmpsec < 60)) {
  209:             $sec = $tmpsec;
  210:         }
  211:     }
  212:     if (defined($ENV{'form.'.$dname.'_minute'})) {
  213:         my $tmpmin = $ENV{'form.'.$dname.'_minute'};
  214:         if (($tmpmin =~ /^\d+$/) && ($tmpmin >= 0) && ($tmpmin < 60)) {
  215:             $min = $tmpmin;
  216:         }
  217:     }
  218:     if (defined($ENV{'form.'.$dname.'_hour'})) {
  219:         my $tmphour = $ENV{'form.'.$dname.'_hour'};
  220:         if (($tmphour =~ /^\d+$/) && ($tmphour > 0) && ($tmphour < 32)) {
  221:             $hour = $tmphour;
  222:         }
  223:     }
  224:     if (defined($ENV{'form.'.$dname.'_day'})) {
  225:         my $tmpday = $ENV{'form.'.$dname.'_day'};
  226:         if (($tmpday =~ /^\d+$/) && ($tmpday > 0) && ($tmpday < 32)) {
  227:             $day = $tmpday;
  228:         }
  229:     }
  230:     if (defined($ENV{'form.'.$dname.'_month'})) {
  231:         my $tmpmonth = $ENV{'form.'.$dname.'_month'};
  232:         if (($tmpmonth =~ /^\d+$/) && ($tmpmonth > 0) && ($tmpmonth < 13)) {
  233:             $month = $tmpmonth - 1;
  234:         }
  235:     }
  236:     if (defined($ENV{'form.'.$dname.'_year'})) {
  237:         my $tmpyear = $ENV{'form.'.$dname.'_year'};
  238:         if (($tmpyear =~ /^\d+$/) && ($tmpyear > 1900)) {
  239:             $year = $tmpyear - 1900;
  240:         }
  241:     }
  242:     if (eval(&timelocal($sec,$min,$hour,$day,$month,$year))) {
  243:         return &timelocal($sec,$min,$hour,$day,$month,$year);
  244:     } else {
  245:         return undef;
  246:     }
  247: }
  248: 
  249: ##############################################
  250: ##############################################
  251: 
  252: =pod
  253: 
  254: =item &pjump_javascript_definition()
  255: 
  256: Returns javascript defining the 'pjump' function, which opens up a
  257: parameter setting wizard.
  258: 
  259: =cut
  260: 
  261: ##############################################
  262: ##############################################
  263: sub pjump_javascript_definition {
  264:     my $Str = <<END;
  265:     function pjump(type,dis,value,marker,ret,call) {
  266:         parmwin=window.open("/adm/rat/parameter.html?type="+escape(type)
  267:                  +"&value="+escape(value)+"&marker="+escape(marker)
  268:                  +"&return="+escape(ret)
  269:                  +"&call="+escape(call)+"&name="+escape(dis),"LONCAPAparms",
  270:                  "height=350,width=350,scrollbars=no,menubar=no");
  271:     }
  272: END
  273:     return $Str;
  274: }
  275: 
  276: ##############################################
  277: ##############################################
  278: 
  279: =pod
  280: 
  281: =item &javascript_nothing()
  282: 
  283: Return an appropriate null for the users browser.  This is used
  284: as the first arguement for window.open calls when you want a blank
  285: window that you can then write to.
  286: 
  287: =cut
  288: 
  289: ##############################################
  290: ##############################################
  291: sub javascript_nothing {
  292:     # mozilla and other browsers work with "''", but IE on mac does not.
  293:     my $nothing = "''";
  294:     my $user_browser;
  295:     my $user_os;
  296:     $user_browser = $ENV{'browser.type'} if (exists($ENV{'browser.type'}));
  297:     $user_os      = $ENV{'browser.os'}   if (exists($ENV{'browser.os'}));
  298:     if (! defined($user_browser) || ! defined($user_os)) {
  299:         (undef,$user_browser,undef,undef,undef,$user_os) = 
  300:                            &Apache::loncommon::decode_user_agent();
  301:     }
  302:     if ($user_browser eq 'explorer' && $user_os =~ 'mac') {
  303:         $nothing = "'javascript:void(0);'";
  304:     }
  305:     return $nothing;
  306: }
  307: 
  308: 
  309: ##############################################
  310: ##############################################
  311: 
  312: =pod
  313: 
  314: =item &StatusOptions()
  315: 
  316: Returns html for a selection box which allows the user to choose the
  317: enrollment status of students.  The selection box name is 'Status'.
  318: 
  319: Inputs:
  320: 
  321: $status: the currently selected status.  If undefined the value of
  322: $ENV{'form.Status'} is taken.  If that is undefined, a value of 'Active'
  323: is used.
  324: 
  325: $formname: The name of the form.  If defined the onchange attribute of
  326: the selection box is set to document.$formname.submit().
  327: 
  328: $size: the size (number of lines) of the selection box.
  329: 
  330: Returns: a perl string as described.
  331: 
  332: =cut
  333: 
  334: ##############################################
  335: ##############################################
  336: sub StatusOptions {
  337:     my ($status, $formName,$size)=@_;
  338:     $size = 1 if (!defined($size));
  339:     if (! defined($status)) {
  340:         $status = 'Active';
  341:         $status = $ENV{'form.Status'} if (exists($ENV{'form.Status'}));
  342:     }
  343: 
  344:     my $OpSel1 = '';
  345:     my $OpSel2 = '';
  346:     my $OpSel3 = '';
  347: 
  348:     if($status eq 'Any')         { $OpSel3 = ' selected'; }
  349:     elsif($status eq 'Expired' ) { $OpSel2 = ' selected'; }
  350:     else                         { $OpSel1 = ' selected'; }
  351: 
  352:     my $Str = '';
  353:     $Str .= '<select name="Status"';
  354:     if(defined($formName) && $formName ne '') {
  355:         $Str .= ' onchange="document.'.$formName.'.submit()"';
  356:     }
  357:     $Str .= ' size="'.$size.'" ';
  358:     $Str .= '>'."\n";
  359:     $Str .= '<option value="Active" '.$OpSel1.'>'.
  360:         'Currently Enrolled</option>'."\n";
  361:     $Str .= '<option value="Expired" '.$OpSel2.'>'.
  362:         'Previously Enrolled</option>'."\n";
  363:     $Str .= '<option value="Any" '.$OpSel3.'>'.
  364:         'Any Enrollment Status</option>'."\n";
  365:     $Str .= '</select>'."\n";
  366: }
  367: 
  368: 
  369: ########################################################
  370: ########################################################
  371: 
  372: =pod
  373: 
  374: =item &MultipleSectionSelect()
  375: 
  376: Inputs: 
  377: 
  378: =over 4
  379: 
  380: =item $sections A references to an array containing the names of all the
  381: sections used in a class.
  382: 
  383: =item $selectedSections A reference to an array containing the names of the
  384: currently selected sections.
  385: 
  386: =back 
  387: 
  388: Returns: a string containing HTML for a multiple select box for
  389: selecting sections of a course.  
  390: 
  391: The form element name is 'Section'.  @$sections is sorted prior to output.
  392: 
  393: =cut
  394: 
  395: ########################################################
  396: ########################################################
  397: sub MultipleSectionSelect {
  398:     my ($sections,$selectedSections)=@_;
  399: 
  400:     my $Str = '';
  401:     $Str .= '<select name="Section" multiple="true" size="4">'."\n";
  402: 
  403:     foreach (sort @$sections) {
  404:         $Str .= '<option';
  405:         foreach my $selected (@$selectedSections) {
  406:             if($_ eq $selected) {
  407:                 $Str .= ' selected=""';
  408:             }
  409:         }
  410:         $Str .= '>'.$_.'</option>'."\n";
  411:     }
  412:     $Str .= '</select>'."\n";
  413:     
  414:     return $Str;
  415: }
  416: 
  417: ########################################################
  418: ########################################################
  419: 
  420: =pod
  421: 
  422: =item &Title()
  423: 
  424: Inputs: $pageName a string containing the name of the page to be sent
  425: to &Apache::loncommon::bodytag.
  426: 
  427: Returns: string containing being <html> and complete <head> and <title>
  428: as well as a <script> to focus the current window and change its width
  429: and height to 500.  Why?  I do not know.  If you find out, please update
  430: this documentation.
  431: 
  432: =cut
  433: 
  434: ########################################################
  435: ########################################################
  436: sub Title {
  437:     my ($pageName)=@_;
  438: 
  439:     my $Str = '';
  440: 
  441:     $Str .= '<html><head><title>'.$pageName.'</title></head>'."\n";
  442:     $Str .= &Apache::loncommon::bodytag($pageName)."\n";
  443:     $Str .= '<script>window.focus(); window.width=500;window.height=500;';
  444:     $Str .= '</script>'."\n";
  445: 
  446:     return $Str;
  447: }
  448: 
  449: ########################################################
  450: ########################################################
  451: 
  452: =pod
  453: 
  454: =item &CreateHeadings()
  455: 
  456: This function generates the column headings for the chart.
  457: 
  458: =over 4
  459: 
  460: Inputs: $CacheData, $keyID, $headings, $spacePadding
  461: 
  462: $CacheData: pointer to a hash tied to the cached data database
  463: 
  464: $keyID: a pointer to an array containing the names of the data 
  465: held in a column and is used as part of a key into $CacheData
  466: 
  467: $headings: The names of the headings for the student information
  468: 
  469: $spacePadding: The spaces to go between columns
  470: 
  471: Output: $Str
  472: 
  473: $Str: A formatted string of the table column headings.
  474: 
  475: =back
  476: 
  477: =cut
  478: 
  479: ########################################################
  480: ########################################################
  481: sub CreateHeadings {
  482:     my ($data,$keyID,$headings,$displayString,$format)=@_;
  483:     my $Str='';
  484:     my $formatting = '';
  485: 
  486:     for(my $index=0; $index<(scalar @$headings); $index++) {
  487:  	my $currentHeading=$headings->[$index];
  488:         if($format eq 'preformatted') {
  489:             my @dataLength=split(//,$currentHeading);
  490:             my $length=scalar @dataLength;
  491:             $formatting = (' 'x
  492:                       ($data->{$keyID->[$index].':columnWidth'}-$length));
  493:         }
  494:         my $linkdata=$keyID->[$index];
  495: 
  496:         my $tempString = $displayString;
  497:         $tempString =~ s/LINKDATA/$linkdata/;
  498:         $tempString =~ s/DISPLAYDATA/$currentHeading/;
  499:         $tempString =~ s/FORMATTING/$formatting/;
  500: 
  501:         $Str .= $tempString;
  502:     }
  503: 
  504:     return $Str;
  505: }
  506: 
  507: ########################################################
  508: ########################################################
  509: 
  510: =pod
  511: 
  512: =item &FormatStudentInformation()
  513: 
  514: This function produces a formatted string of the student\'s information:
  515: username, domain, section, full name, and PID.
  516: 
  517: =over 4
  518: 
  519: Input: $cache, $name, $keyID, $spacePadding
  520: 
  521: $cache: This is a pointer to a hash that is tied to the cached data
  522: 
  523: $name:  The name and domain of the current student in name:domain format
  524: 
  525: $keyID: A pointer to an array holding the names used to
  526: 
  527: remove data from the hash.  They represent the name of the data to be removed.
  528: 
  529: $spacePadding: Extra spaces that represent the space between columns
  530: 
  531: Output: $Str
  532: 
  533: $Str: Formatted string.
  534: 
  535: =back
  536: 
  537: =cut
  538: 
  539: ########################################################
  540: ########################################################
  541: sub FormatStudentInformation {
  542:     my ($data,$name,$keyID,$displayString,$format)=@_;
  543:     my $Str='';
  544:     my $currentColumn;
  545: 
  546:     for(my $index=0; $index<(scalar @$keyID); $index++) {
  547:         $currentColumn=$data->{$name.':'.$keyID->[$index]};
  548: 
  549:         if($format eq 'preformatted') {
  550:             my @dataLength=split(//,$currentColumn);
  551:             my $length=scalar @dataLength;
  552:             $currentColumn.= (' 'x
  553:                      ($data->{$keyID->[$index].':columnWidth'}-$length));
  554:         }
  555: 
  556:         my $tempString = $displayString;
  557:         $tempString =~ s/DISPLAYDATA/$currentColumn/;
  558: 
  559:         $Str .= $tempString;
  560:     }
  561: 
  562:     return $Str;
  563: }
  564: 
  565: ########################################################
  566: ########################################################
  567: 
  568: # Create progress
  569: sub Create_PrgWin {
  570:     my ($r, $title, $heading, $number_to_do)=@_;
  571:     $r->print('<script>'.
  572:     "popwin=open(\'\',\'popwin\',\'width=400,height=100\');".
  573:     "popwin.document.writeln(\'<html><head><title>$title</title></head>".
  574: 	      "<body bgcolor=\"#88DDFF\">".
  575:               "<h4>$heading</h4>".
  576:               "<form name=popremain>".
  577:               "<input type=text size=55 name=remaining value=Starting></form>".
  578:               "</body></html>\');".
  579:     "popwin.document.close();".
  580:     "</script>");
  581: 
  582:     my %prog_state;
  583:     $prog_state{'done'}=0;
  584:     $prog_state{'firststart'}=time;
  585:     $prog_state{'laststart'}=time;
  586:     $prog_state{'max'}=$number_to_do;
  587: 
  588:     $r->rflush();
  589:     return %prog_state;
  590: }
  591: 
  592: # update progress
  593: sub Update_PrgWin {
  594:     my ($r,$prog_state,$displayString)=@_;
  595:     $r->print('<script>popwin.document.popremain.remaining.value="'.
  596:               $displayString.'";</script>');
  597:     $$prog_state{'laststart'}=time;
  598:     $r->rflush();
  599: }
  600: 
  601: # increment progress state
  602: sub Increment_PrgWin {
  603:     my ($r,$prog_state,$extraInfo)=@_;
  604:     $$prog_state{'done'}++;
  605:     my $time_est= (time - $$prog_state{'firststart'})/$$prog_state{'done'} *
  606: 	($$prog_state{'max'}-$$prog_state{'done'});
  607:     $time_est = int($time_est);
  608:     if (int ($time_est/60) > 0) {
  609: 	my $min = int($time_est/60);
  610: 	my $sec = $time_est % 60;
  611: 	$time_est = $min.' minutes';
  612: 	if ($sec > 1) {
  613: 	    $time_est.= ', '.$sec.' seconds';
  614: 	} elsif ($sec > 0) {
  615: 	    $time_est.= ', '.$sec.' second';
  616: 	}
  617:     } else {
  618: 	$time_est .= ' seconds';
  619:     }
  620:     my $lasttime = time-$$prog_state{'laststart'};
  621:     if ($lasttime == 1) {
  622:         $lasttime = '('.$lasttime.' second for '.$extraInfo.')';
  623:     } else {
  624:         $lasttime = '('.$lasttime.' seconds for '.$extraInfo.')';
  625:     }
  626:     $r->print('<script>popwin.document.popremain.remaining.value="'.
  627: 	      $$prog_state{'done'}.'/'.$$prog_state{'max'}.
  628: 	      ': '.$time_est.' remaining '.$lasttime.'";'.'</script>');
  629:     $$prog_state{'laststart'}=time;
  630:     $r->rflush();
  631: }
  632: 
  633: # close Progress Line
  634: sub Close_PrgWin {
  635:     my ($r,$prog_state)=@_;
  636:     $r->print('<script>popwin.close()</script>'."\n");
  637:     undef(%$prog_state);
  638:     $r->rflush(); 
  639: }
  640: 
  641: 1;
  642: __END__

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