Return to lonhtmlcommon.pm CVS log

Up to [LON-CAPA] / loncom / interface

get_date_from_form: Restrict hours to being ge 0 and lt 24, not gt 0 and lt 32
(cut and paste coding :( )
Added more error checking on the date generation.  This routine is more strict
about the data it accepts and will return 'undef' if any of the date forms is
not present.  This will not be an issue because the &date_setter routine makes
sure all of the form elements are generated.

    1: # The LearningOnline Network with CAPA
    2: # a pile of common html routines
    3: #
    4: # $Id: lonhtmlcommon.pm,v 1.33 2003/10/17 19:56:13 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 Apache::lonlocal;
   60: use strict;
   61: 
   62: 
   63: ##############################################
   64: ##############################################
   65: 
   66: =pod
   67: 
   68: =item textbox
   69: 
   70: =cut
   71: 
   72: ##############################################
   73: ##############################################
   74: sub textbox {
   75:     my ($name,$value,$size,$special) = @_;
   76:     $size = 40 if (! defined($size));
   77:     my $Str = '<input type="text" name="'.$name.'" size="'.$size.'" '.
   78:         'value="'.$value.'" '.$special.' />';
   79:     return $Str;
   80: }
   81: 
   82: ##############################################
   83: ##############################################
   84: 
   85: =pod
   86: 
   87: =item checkbox
   88: 
   89: =cut
   90: 
   91: ##############################################
   92: ##############################################
   93: sub checkbox {
   94:     my ($name) = @_;
   95:     my $Str = '<input type="checkbox" name="'.$name.'" />';
   96:     return $Str;
   97: }
   98: 
   99: 
  100: 
  101: ##############################################
  102: ##############################################
  103: 
  104: =pod
  105: 
  106: =item &date_setter
  107: 
  108: &date_setter returns html and javascript for a compact date-setting form.
  109: To retrieve values from it, use &get_date_from_form().
  110: 
  111: Inputs
  112: 
  113: =over 4
  114: 
  115: =item $dname 
  116: 
  117: The name to prepend to the form elements.  
  118: The form elements defined will be dname_year, dname_month, dname_day,
  119: dname_hour, dname_min, and dname_sec.
  120: 
  121: =item $currentvalue
  122: 
  123: The current setting for this time parameter.  A unix format time
  124: (time in seconds since the beginning of Jan 1st, 1970, GMT.  
  125: An undefined value is taken to indicate the value is the current time.
  126: Also, to be explicit, a value of 'now' also indicates the current time.
  127: 
  128: =item $special
  129: 
  130: Additional html/javascript to be associated with each element in
  131: the date_setter.  See lonparmset for example usage.
  132: 
  133: =back
  134: 
  135: Bugs
  136: 
  137: The method used to restrict user input will fail in the year 2400.
  138: 
  139: =cut
  140: 
  141: ##############################################
  142: ##############################################
  143: sub date_setter {
  144:     my ($formname,$dname,$currentvalue,$special) = @_;
  145:     if (! defined($currentvalue) || $currentvalue eq 'now') {
  146:         $currentvalue = time;
  147:     }
  148:     # other potentially useful values:     wkday,yrday,is_daylight_savings
  149:     my ($sec,$min,$hour,$mday,$month,$year,undef,undef,undef) = 
  150:         localtime($currentvalue);
  151:     $year += 1900;
  152:     my $result = "\n<!-- $dname date setting form -->\n";
  153:     $result .= <<ENDJS;
  154: <script language="Javascript">
  155:     function $dname\_checkday() {
  156:         var day   = document.$formname.$dname\_day.value;
  157:         var month = document.$formname.$dname\_month.value;
  158:         var year  = document.$formname.$dname\_year.value;
  159:         var valid = true;
  160:         if (day < 1) {
  161:             document.$formname.$dname\_day.value = 1;
  162:         } 
  163:         if (day > 31) {
  164:             document.$formname.$dname\_day.value = 31;
  165:         }
  166:         if ((month == 1)  || (month == 3)  || (month == 5)  ||
  167:             (month == 7)  || (month == 8)  || (month == 10) ||
  168:             (month == 12)) {
  169:             if (day > 31) {
  170:                 document.$formname.$dname\_day.value = 31;
  171:                 day = 31;
  172:             }
  173:         } else if (month == 2 ) {
  174:             if ((year % 4 == 0) && (year % 100 != 0)) {
  175:                 if (day > 29) {
  176:                     document.$formname.$dname\_day.value = 29;
  177:                 }
  178:             } else if (day > 29) {
  179:                 document.$formname.$dname\_day.value = 28;
  180:             }
  181:         } else if (day > 30) {
  182:             document.$formname.$dname\_day.value = 30;
  183:         }
  184:     }
  185: 
  186:     function $dname\_opencalendar() {
  187:        var calwin=window.open(
  188: "/adm/announcements?pickdate=yes&formname=$formname&element=$dname&month="+
  189: document.$formname.$dname\_month.value+"&year="+
  190: document.$formname.$dname\_year.value,
  191:              "LONCAPAcal",
  192:               "height=350,width=350,scrollbars=yes,resizable=yes,menubar=no");
  193: 
  194:     }
  195: </script>
  196: ENDJS
  197:     $result .= "  <nobr><select name=\"$dname\_month\" ".$special.' '.
  198:         "onChange=\"javascript:$dname\_checkday()\" >\n";
  199:     my @Months = qw/January February  March     April   May      June 
  200:                     July    August    September October November December/;
  201:     # Pad @Months with a bogus value to make indexing easier
  202:     unshift(@Months,'If you can read this an error occurred');
  203:     for(my $m = 1;$m <=$#Months;$m++) {
  204:         $result .= "      <option value=\"$m\" ";
  205:         $result .= "selected " if ($m-1 == $month);
  206:         $result .= "> ".&mt($Months[$m])." </option>\n";
  207:     }
  208:     $result .= "  </select>\n";
  209:     $result .= "  <input type=\"text\" name=\"$dname\_day\" ".
  210:             "value=\"$mday\" size=\"3\" ".$special.' '.
  211:             "onChange=\"javascript:$dname\_checkday()\" />\n";
  212:     $result .= "  <input type=\"year\" name=\"$dname\_year\" ".
  213:             "value=\"$year\" size=\"5\" ".$special.' '.
  214:             "onChange=\"javascript:$dname\_checkday()\" />\n";
  215:     $result .= "&nbsp;&nbsp;";
  216:     $result .= "  <select name=\"$dname\_hour\" ".$special." >\n";
  217:     for (my $h = 0;$h<24;$h++) {
  218:         $result .= "      <option value=\"$h\" ";
  219:         $result .= "selected " if ($hour == $h);
  220:         $result .= "> ";
  221: 	my $timest='';
  222:         if ($h == 0) {
  223:             $timest .= "12 am";
  224:         } elsif($h == 12) {
  225:             $timest .= "12 noon";
  226:         } elsif($h < 12) {
  227:             $timest .= "$h am";
  228:         } else {
  229:             $timest .= $h-12 ." pm";
  230:         }
  231: 	$timest=&mt($timest);
  232:         $result .= $timest." </option>\n";
  233:     } 
  234:     $result .= "  </select>\n";
  235:     $result .= "  <input type=\"text\" name=\"$dname\_minute\" ".$special.' '.
  236:         "value=\"$min\" size=\"3\" /> m\n";
  237:     $result .= "  <input type=\"text\" name=\"$dname\_second\" ".$special.' '.
  238:         "value=\"$sec\" size=\"3\" /> s\n";
  239:     $result .= "<a href=\"javascript:$dname\_opencalendar()\">".
  240:     &mt('Select Date')."</a></nobr>\n<!-- end $dname date setting form -->\n";
  241:     return $result;
  242: }
  243: 
  244: ##############################################
  245: ##############################################
  246: 
  247: =pod
  248: 
  249: =item &get_date_from_form
  250: 
  251: get_date_from_form retrieves the date specified in an &date_setter form.
  252: 
  253: Inputs:
  254: 
  255: =over 4
  256: 
  257: =item $dname
  258: 
  259: The name passed to &datesetter, which prefixes the form elements.
  260: 
  261: =item $defaulttime
  262: 
  263: The unix time to use as the default in case of poor inputs.
  264: 
  265: =back
  266: 
  267: Returns: Unix time represented in the form.
  268: 
  269: =cut
  270: 
  271: ##############################################
  272: ##############################################
  273: sub get_date_from_form {
  274:     my ($dname) = @_;
  275:     my ($sec,$min,$hour,$day,$month,$year);
  276:     #
  277:     if (defined($ENV{'form.'.$dname.'_second'})) {
  278:         my $tmpsec = $ENV{'form.'.$dname.'_second'};
  279:         if (($tmpsec =~ /^\d+$/) && ($tmpsec >= 0) && ($tmpsec < 60)) {
  280:             $sec = $tmpsec;
  281:         }
  282:     }
  283:     if (defined($ENV{'form.'.$dname.'_minute'})) {
  284:         my $tmpmin = $ENV{'form.'.$dname.'_minute'};
  285:         if (($tmpmin =~ /^\d+$/) && ($tmpmin >= 0) && ($tmpmin < 60)) {
  286:             $min = $tmpmin;
  287:         }
  288:     }
  289:     if (defined($ENV{'form.'.$dname.'_hour'})) {
  290:         my $tmphour = $ENV{'form.'.$dname.'_hour'};
  291:         if (($tmphour =~ /^\d+$/) && ($tmphour >= 0) && ($tmphour < 24)) {
  292:             $hour = $tmphour;
  293:         }
  294:     }
  295:     if (defined($ENV{'form.'.$dname.'_day'})) {
  296:         my $tmpday = $ENV{'form.'.$dname.'_day'};
  297:         if (($tmpday =~ /^\d+$/) && ($tmpday > 0) && ($tmpday < 32)) {
  298:             $day = $tmpday;
  299:         }
  300:     }
  301:     if (defined($ENV{'form.'.$dname.'_month'})) {
  302:         my $tmpmonth = $ENV{'form.'.$dname.'_month'};
  303:         if (($tmpmonth =~ /^\d+$/) && ($tmpmonth > 0) && ($tmpmonth < 13)) {
  304:             $month = $tmpmonth - 1;
  305:         }
  306:     }
  307:     if (defined($ENV{'form.'.$dname.'_year'})) {
  308:         my $tmpyear = $ENV{'form.'.$dname.'_year'};
  309:         if (($tmpyear =~ /^\d+$/) && ($tmpyear > 1900)) {
  310:             $year = $tmpyear - 1900;
  311:         }
  312:     }
  313:     if (($year<70) || ($year>137)) { return undef; }
  314:     if (defined($sec) && defined($min)   && defined($hour) &&
  315:         defined($day) && defined($month) && defined($year) &&
  316:         eval(&timelocal($sec,$min,$hour,$day,$month,$year))) {
  317:         return &timelocal($sec,$min,$hour,$day,$month,$year);
  318:     } else {
  319:         return undef;
  320:     }
  321: }
  322: 
  323: ##############################################
  324: ##############################################
  325: 
  326: =pod
  327: 
  328: =item &pjump_javascript_definition()
  329: 
  330: Returns javascript defining the 'pjump' function, which opens up a
  331: parameter setting wizard.
  332: 
  333: =cut
  334: 
  335: ##############################################
  336: ##############################################
  337: sub pjump_javascript_definition {
  338:     my $Str = <<END;
  339:     function pjump(type,dis,value,marker,ret,call) {
  340:         parmwin=window.open("/adm/rat/parameter.html?type="+escape(type)
  341:                  +"&value="+escape(value)+"&marker="+escape(marker)
  342:                  +"&return="+escape(ret)
  343:                  +"&call="+escape(call)+"&name="+escape(dis),"LONCAPAparms",
  344:                  "height=350,width=350,scrollbars=no,menubar=no");
  345:     }
  346: END
  347:     return $Str;
  348: }
  349: 
  350: ##############################################
  351: ##############################################
  352: 
  353: =pod
  354: 
  355: =item &javascript_nothing()
  356: 
  357: Return an appropriate null for the users browser.  This is used
  358: as the first arguement for window.open calls when you want a blank
  359: window that you can then write to.
  360: 
  361: =cut
  362: 
  363: ##############################################
  364: ##############################################
  365: sub javascript_nothing {
  366:     # mozilla and other browsers work with "''", but IE on mac does not.
  367:     my $nothing = "''";
  368:     my $user_browser;
  369:     my $user_os;
  370:     $user_browser = $ENV{'browser.type'} if (exists($ENV{'browser.type'}));
  371:     $user_os      = $ENV{'browser.os'}   if (exists($ENV{'browser.os'}));
  372:     if (! defined($user_browser) || ! defined($user_os)) {
  373:         (undef,$user_browser,undef,undef,undef,$user_os) = 
  374:                            &Apache::loncommon::decode_user_agent();
  375:     }
  376:     if ($user_browser eq 'explorer' && $user_os =~ 'mac') {
  377:         $nothing = "'javascript:void(0);'";
  378:     }
  379:     return $nothing;
  380: }
  381: 
  382: 
  383: ##############################################
  384: ##############################################
  385: 
  386: =pod
  387: 
  388: =item &StatusOptions()
  389: 
  390: Returns html for a selection box which allows the user to choose the
  391: enrollment status of students.  The selection box name is 'Status'.
  392: 
  393: Inputs:
  394: 
  395: $status: the currently selected status.  If undefined the value of
  396: $ENV{'form.Status'} is taken.  If that is undefined, a value of 'Active'
  397: is used.
  398: 
  399: $formname: The name of the form.  If defined the onchange attribute of
  400: the selection box is set to document.$formname.submit().
  401: 
  402: $size: the size (number of lines) of the selection box.
  403: 
  404: $onchange: javascript to use when the value is changed.  Enclosed in 
  405: double quotes, ""s, not single quotes.
  406: 
  407: Returns: a perl string as described.
  408: 
  409: =cut
  410: 
  411: ##############################################
  412: ##############################################
  413: sub StatusOptions {
  414:     my ($status, $formName,$size,$onchange)=@_;
  415:     $size = 1 if (!defined($size));
  416:     if (! defined($status)) {
  417:         $status = 'Active';
  418:         $status = $ENV{'form.Status'} if (exists($ENV{'form.Status'}));
  419:     }
  420: 
  421:     my $OpSel1 = '';
  422:     my $OpSel2 = '';
  423:     my $OpSel3 = '';
  424: 
  425:     if($status eq 'Any')         { $OpSel3 = ' selected'; }
  426:     elsif($status eq 'Expired' ) { $OpSel2 = ' selected'; }
  427:     else                         { $OpSel1 = ' selected'; }
  428: 
  429:     my $Str = '';
  430:     $Str .= '<select name="Status"';
  431:     if(defined($formName) && $formName ne '' && ! defined($onchange)) {
  432:         $Str .= ' onchange="document.'.$formName.'.submit()"';
  433:     }
  434:     if (defined($onchange)) {
  435:         $Str .= ' onchange="'.$onchange.'"';
  436:     }
  437:     $Str .= ' size="'.$size.'" ';
  438:     $Str .= '>'."\n";
  439:     $Str .= '<option value="Active" '.$OpSel1.'>'.
  440:         'Currently Enrolled</option>'."\n";
  441:     $Str .= '<option value="Expired" '.$OpSel2.'>'.
  442:         'Previously Enrolled</option>'."\n";
  443:     $Str .= '<option value="Any" '.$OpSel3.'>'.
  444:         'Any Enrollment Status</option>'."\n";
  445:     $Str .= '</select>'."\n";
  446: }
  447: 
  448: 
  449: ########################################################
  450: ########################################################
  451: 
  452: =pod
  453: 
  454: =item &MultipleSectionSelect()
  455: 
  456: Inputs: 
  457: 
  458: =over 4
  459: 
  460: =item $sections A references to an array containing the names of all the
  461: sections used in a class.
  462: 
  463: =item $selectedSections A reference to an array containing the names of the
  464: currently selected sections.
  465: 
  466: =back 
  467: 
  468: Returns: a string containing HTML for a multiple select box for
  469: selecting sections of a course.  
  470: 
  471: The form element name is 'Section'.  @$sections is sorted prior to output.
  472: 
  473: =cut
  474: 
  475: ########################################################
  476: ########################################################
  477: sub MultipleSectionSelect {
  478:     my ($sections,$selectedSections)=@_;
  479: 
  480:     my $Str = '';
  481:     $Str .= '<select name="Section" multiple="true" size="4">'."\n";
  482: 
  483:     foreach (sort @$sections) {
  484:         $Str .= '<option';
  485:         foreach my $selected (@$selectedSections) {
  486:             if($_ eq $selected) {
  487:                 $Str .= ' selected=""';
  488:             }
  489:         }
  490:         $Str .= '>'.$_.'</option>'."\n";
  491:     }
  492:     $Str .= '</select>'."\n";
  493:     
  494:     return $Str;
  495: }
  496: 
  497: ########################################################
  498: ########################################################
  499: 
  500: =pod
  501: 
  502: =item &Title()
  503: 
  504: Inputs: $pageName a string containing the name of the page to be sent
  505: to &Apache::loncommon::bodytag.
  506: 
  507: Returns: string containing being <html> and complete <head> and <title>
  508: as well as a <script> to focus the current window and change its width
  509: and height to 500.  Why?  I do not know.  If you find out, please update
  510: this documentation.
  511: 
  512: =cut
  513: 
  514: ########################################################
  515: ########################################################
  516: sub Title {
  517:     my ($pageName)=@_;
  518: 
  519:     my $Str = '';
  520: 
  521:     $Str .= '<html><head><title>'.$pageName.'</title></head>'."\n";
  522:     $Str .= &Apache::loncommon::bodytag($pageName)."\n";
  523:     $Str .= '<script>window.focus(); window.width=500;window.height=500;';
  524:     $Str .= '</script>'."\n";
  525: 
  526:     return $Str;
  527: }
  528: 
  529: ########################################################
  530: ########################################################
  531: 
  532: =pod
  533: 
  534: =item &CreateHeadings()
  535: 
  536: This function generates the column headings for the chart.
  537: 
  538: =over 4
  539: 
  540: Inputs: $CacheData, $keyID, $headings, $spacePadding
  541: 
  542: $CacheData: pointer to a hash tied to the cached data database
  543: 
  544: $keyID: a pointer to an array containing the names of the data 
  545: held in a column and is used as part of a key into $CacheData
  546: 
  547: $headings: The names of the headings for the student information
  548: 
  549: $spacePadding: The spaces to go between columns
  550: 
  551: Output: $Str
  552: 
  553: $Str: A formatted string of the table column headings.
  554: 
  555: =back
  556: 
  557: =cut
  558: 
  559: ########################################################
  560: ########################################################
  561: sub CreateHeadings {
  562:     my ($data,$keyID,$headings,$displayString,$format)=@_;
  563:     my $Str='';
  564:     my $formatting = '';
  565: 
  566:     for(my $index=0; $index<(scalar @$headings); $index++) {
  567:  	my $currentHeading=$headings->[$index];
  568:         if($format eq 'preformatted') {
  569:             my @dataLength=split(//,$currentHeading);
  570:             my $length=scalar @dataLength;
  571:             $formatting = (' 'x
  572:                       ($data->{$keyID->[$index].':columnWidth'}-$length));
  573:         }
  574:         my $linkdata=$keyID->[$index];
  575: 
  576:         my $tempString = $displayString;
  577:         $tempString =~ s/LINKDATA/$linkdata/;
  578:         $tempString =~ s/DISPLAYDATA/$currentHeading/;
  579:         $tempString =~ s/FORMATTING/$formatting/;
  580: 
  581:         $Str .= $tempString;
  582:     }
  583: 
  584:     return $Str;
  585: }
  586: 
  587: ########################################################
  588: ########################################################
  589: 
  590: =pod
  591: 
  592: =item &FormatStudentInformation()
  593: 
  594: This function produces a formatted string of the student\'s information:
  595: username, domain, section, full name, and PID.
  596: 
  597: =over 4
  598: 
  599: Input: $cache, $name, $keyID, $spacePadding
  600: 
  601: $cache: This is a pointer to a hash that is tied to the cached data
  602: 
  603: $name:  The name and domain of the current student in name:domain format
  604: 
  605: $keyID: A pointer to an array holding the names used to
  606: 
  607: remove data from the hash.  They represent the name of the data to be removed.
  608: 
  609: $spacePadding: Extra spaces that represent the space between columns
  610: 
  611: Output: $Str
  612: 
  613: $Str: Formatted string.
  614: 
  615: =back
  616: 
  617: =cut
  618: 
  619: ########################################################
  620: ########################################################
  621: sub FormatStudentInformation {
  622:     my ($data,$name,$keyID,$displayString,$format)=@_;
  623:     my $Str='';
  624:     my $currentColumn;
  625: 
  626:     for(my $index=0; $index<(scalar @$keyID); $index++) {
  627:         $currentColumn=$data->{$name.':'.$keyID->[$index]};
  628: 
  629:         if($format eq 'preformatted') {
  630:             my @dataLength=split(//,$currentColumn);
  631:             my $length=scalar @dataLength;
  632:             $currentColumn.= (' 'x
  633:                      ($data->{$keyID->[$index].':columnWidth'}-$length));
  634:         }
  635: 
  636:         my $tempString = $displayString;
  637:         $tempString =~ s/DISPLAYDATA/$currentColumn/;
  638: 
  639:         $Str .= $tempString;
  640:     }
  641: 
  642:     return $Str;
  643: }
  644: 
  645: ########################################################
  646: ########################################################
  647: 
  648: =pod
  649: 
  650: =item Progess Window Handling Routines
  651: 
  652: These routines handle the creation, update, increment, and closure of 
  653: progress windows.  The progress window reports to the user the number
  654: of items completed and an estimate of the time required to complete the rest.
  655: 
  656: =over 4
  657: 
  658: 
  659: =item &Create_PrgWin
  660: 
  661: Writes javascript to the client to open a progress window and returns a
  662: data structure used for bookkeeping.
  663: 
  664: Inputs
  665: 
  666: =over 4
  667: 
  668: =item $r Apache request
  669: 
  670: =item $title The title of the progress window
  671: 
  672: =item $heading A description (usually 1 line) of the process being initiated.
  673: 
  674: =item $number_to_do The total number of items being processed.
  675: 
  676: =back
  677: 
  678: Returns a hash containing the progress state data structure.
  679: 
  680: 
  681: =item &Update_PrgWin
  682: 
  683: Updates the text in the progress indicator.  Does not increment the count.
  684: See &Increment_PrgWin.
  685: 
  686: Inputs:
  687: 
  688: =over 4
  689: 
  690: =item $r Apache request
  691: 
  692: =item $prog_state Pointer to the data structure returned by &Create_PrgWin
  693: 
  694: =item $displaystring The string to write to the status indicator
  695: 
  696: =back
  697: 
  698: Returns: none
  699: 
  700: 
  701: =item Increment_PrgWin
  702: 
  703: Increment the count of items completed for the progress window by 1.  
  704: 
  705: Inputs:
  706: 
  707: =over 4
  708: 
  709: =item $r Apache request
  710: 
  711: =item $prog_state Pointer to the data structure returned by Create_PrgWin
  712: 
  713: =item $extraInfo A description of the items being iterated over.  Typically
  714: 'student'.
  715: 
  716: =back
  717: 
  718: Returns: none
  719: 
  720: 
  721: =item Close_PrgWin
  722: 
  723: Closes the progress window.
  724: 
  725: Inputs:
  726: 
  727: =over 4 
  728: 
  729: =item $r Apache request
  730: 
  731: =item $prog_state Pointer to the data structure returned by Create_PrgWin
  732: 
  733: =back
  734: 
  735: Returns: none
  736: 
  737: =back
  738: 
  739: =cut
  740: 
  741: ########################################################
  742: ########################################################
  743: 
  744: # Create progress
  745: sub Create_PrgWin {
  746:     my ($r, $title, $heading, $number_to_do)=@_;
  747:     $r->print('<script>'.
  748:     "popwin=open(\'\',\'popwin\',\'width=400,height=100\');".
  749:     "popwin.document.writeln(\'<html><head><title>$title</title></head>".
  750: 	      "<body bgcolor=\"#88DDFF\">".
  751:               "<h4>$heading</h4>".
  752:               "<form name=popremain>".
  753:               '<input type="text" size="55" name="remaining" value="'.
  754: 	      &mt('Starting').'"></form>'.
  755:               "</body></html>\');".
  756:     "popwin.document.close();".
  757:     "</script>");
  758: 
  759:     my %prog_state;
  760:     $prog_state{'done'}=0;
  761:     $prog_state{'firststart'}=&Time::HiRes::time();
  762:     $prog_state{'laststart'}=&Time::HiRes::time();
  763:     $prog_state{'max'}=$number_to_do;
  764: 
  765:     $r->rflush();
  766:     return %prog_state;
  767: }
  768: 
  769: # update progress
  770: sub Update_PrgWin {
  771:     my ($r,$prog_state,$displayString)=@_;
  772:     $r->print('<script>popwin.document.popremain.remaining.value="'.
  773:               $displayString.'";</script>');
  774:     $$prog_state{'laststart'}=&Time::HiRes::time();
  775:     $r->rflush();
  776: }
  777: 
  778: # increment progress state
  779: sub Increment_PrgWin {
  780:     my ($r,$prog_state,$extraInfo)=@_;
  781:     $$prog_state{'done'}++;
  782:     my $time_est= (&Time::HiRes::time() - $$prog_state{'firststart'})/
  783:         $$prog_state{'done'} *
  784: 	($$prog_state{'max'}-$$prog_state{'done'});
  785:     $time_est = int($time_est);
  786:     if (int ($time_est/60) > 0) {
  787: 	my $min = int($time_est/60);
  788: 	my $sec = $time_est % 60;
  789: 	$time_est = $min.' '.&mt('minutes');
  790:         if ($min < 10)  {
  791:             if ($sec > 1) {
  792:                 $time_est.= ', '.$sec.' '.&mt('seconds');
  793:             } elsif ($sec > 0) {
  794:                 $time_est.= ', '.$sec.' '.&mt('second');
  795:             }
  796:         }
  797:     } else {
  798: 	$time_est .= ' '.&mt('seconds');
  799:     }
  800:     my $lasttime = &Time::HiRes::time()-$$prog_state{'laststart'};
  801:     if ($lasttime > 9) {
  802:         $lasttime = int($lasttime);
  803:     } elsif ($lasttime < 0.01) {
  804:         $lasttime = 0;
  805:     } else {
  806:         $lasttime = sprintf("%3.2f",$lasttime);
  807:     }
  808:     if ($lasttime == 1) {
  809:         $lasttime = '('.$lasttime.' '.&mt('second for').' '.$extraInfo.')';
  810:     } else {
  811:         $lasttime = '('.$lasttime.' '.&mt('seconds for').' '.$extraInfo.')';
  812:     }
  813:     #
  814:     my $user_browser = $ENV{'browser.type'} if (exists($ENV{'browser.type'}));
  815:     my $user_os      = $ENV{'browser.os'}   if (exists($ENV{'browser.os'}));
  816:     if (! defined($user_browser) || ! defined($user_os)) {
  817:         (undef,$user_browser,undef,undef,undef,$user_os) = 
  818:                            &Apache::loncommon::decode_user_agent();
  819:     }
  820:     if ($user_browser eq 'explorer' && $user_os =~ 'mac') {
  821:         $lasttime = '';
  822:     }
  823:     $r->print('<script>popwin.document.popremain.remaining.value="'.
  824: 	      $$prog_state{'done'}.'/'.$$prog_state{'max'}.
  825: 	      ': '.$time_est.' '.&mt('remaining').' '.$lasttime.'";'.'</script>');
  826:     $$prog_state{'laststart'}=&Time::HiRes::time();
  827:     $r->rflush();
  828: }
  829: 
  830: # close Progress Line
  831: sub Close_PrgWin {
  832:     my ($r,$prog_state)=@_;
  833:     $r->print('<script>popwin.close()</script>'."\n");
  834:     undef(%$prog_state);
  835:     $r->rflush(); 
  836: }
  837: 
  838: 1;
  839: 
  840: __END__