Annotation of loncom/interface/lonhtmlcommon.pm, revision 1.20
1.2 www 1: # The LearningOnline Network with CAPA
2: # a pile of common html routines
3: #
1.20 ! matthew 4: # $Id: lonhtmlcommon.pm,v 1.19 2003/03/21 15:59:14 matthew Exp $
1.2 www 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: #
1.10 matthew 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: ######################################################################
1.2 www 55:
1.1 stredwic 56: package Apache::lonhtmlcommon;
57:
1.10 matthew 58: use Time::Local;
1.1 stredwic 59: use strict;
60:
1.10 matthew 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 .= " ";
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: }
1.20 ! matthew 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;
1.10 matthew 274: }
275:
276: ##############################################
277: ##############################################
1.17 matthew 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:
1.10 matthew 312:
1.6 stredwic 313: sub AscendOrderOptions {
314: my ($order, $page, $formName)=@_;
315:
316: my $OpSel1 = '';
317: my $OpSel2 = '';
318:
319: if($order eq 'Ascending') {
320: $OpSel1 = ' selected';
321: } else {
322: $OpSel2 = ' selected';
323: }
324:
325: my $Str = '';
326: $Str .= '<select name="'.(($page)?$page:'').'Ascend"';
327: if($formName) {
328: $Str .= ' onchange="document.'.$formName.'.submit()"';
329: }
330: $Str .= '>'."\n";
331: $Str .= '<option'.$OpSel1.'>Ascending</option>'."\n".
332: '<option'.$OpSel2.'>Descending</option>'."\n";
333: $Str .= '</select>'."\n";
334:
335: return $Str;
336: }
337:
1.1 stredwic 338: sub MapOptions {
1.6 stredwic 339: my ($data, $page, $formName)=@_;
1.1 stredwic 340: my $Str = '';
341: $Str .= '<select name="';
1.6 stredwic 342: $Str .= (($page)?$page:'').'Maps"';
343: if($formName) {
344: $Str .= ' onchange="document.'.$formName.'.submit()"';
345: }
346: $Str .= '>'."\n";
1.1 stredwic 347:
348: my $selected = 0;
349: foreach my $sequence (split(':',$data->{'orderedSequences'})) {
350: $Str .= '<option';
1.7 stredwic 351: if($data->{$page.'Maps'} eq $data->{$sequence.':title'}) {
1.1 stredwic 352: $Str .= ' selected';
353: $selected = 1;
354: }
355: $Str .= '>'.$data->{$sequence.':title'}.'</option>'."\n";
356: }
357: $Str .= '<option';
358: if(!$selected) {
359: $Str .= ' selected';
360: }
361: $Str .= '>All Maps</option>'."\n";
1.9 stredwic 362:
363: $Str .= '</select>'."\n";
364:
365: return $Str;
366: }
367:
368: sub ProblemOptions {
369: my ($data, $page, $map, $formName)=@_;
370: my $Str = '';
371: $Str .= '<select name="';
372: $Str .= (($page)?$page:'').'ProblemSelect"';
373: if($formName) {
374: $Str .= ' onchange="document.'.$formName.'.submit()"';
375: }
376: $Str .= '>'."\n";
377:
378: my $selected = 0;
379: foreach my $sequence (split(':',$data->{'orderedSequences'})) {
380: if($data->{$sequence.':title'} eq $map || $map eq 'All Maps') {
381: foreach my $problem (split(':', $data->{$sequence.':problems'})) {
382: $Str .= '<option';
383: if($data->{$page.'ProblemSelect'} eq
384: $data->{$problem.':title'}) {
385: $Str .= ' selected';
386: $selected = 1;
387: }
388: $Str .= '>'.$data->{$problem.':title'}.'</option>'."\n";
389: }
390: }
391: }
392: $Str .= '<option';
393: if(!$selected) {
394: $Str .= ' selected';
395: }
396: $Str .= '>All Problems</option>'."\n";
397:
398: $Str .= '</select>'."\n";
399:
400: return $Str;
401: }
402:
403: sub PartOptions {
404: my ($data, $page, $parts, $formName)=@_;
405: my $Str = '';
406:
407: if(!defined($parts)) {
408: return '';
409: }
410:
411: $Str .= '<select name="';
412: $Str .= (($page)?$page:'').'PartSelect"';
413: if($formName) {
414: $Str .= ' onchange="document.'.$formName.'.submit()"';
415: }
416: $Str .= '>'."\n";
417:
418: my $selected = 0;
419: foreach my $part (@$parts) {
420: $Str .= '<option';
421: if($data->{$page.'PartSelect'} eq $part) {
422: $Str .= ' selected';
423: $selected = 1;
424: }
425: $Str .= '>'.$part.'</option>'."\n";
426: }
427: $Str .= '<option';
428: if(!$selected) {
429: $Str .= ' selected';
430: }
431: $Str .= '>All Parts</option>'."\n";
1.1 stredwic 432:
433: $Str .= '</select>'."\n";
434:
435: return $Str;
436: }
437:
438: sub StudentOptions {
1.4 stredwic 439: my ($cache, $students, $selectedName, $page, $formName)=@_;
1.1 stredwic 440:
441: my $Str = '';
1.4 stredwic 442: $Str .= '<select name="'.(($page)?$page:'').'Student"';
443: if($formName) {
444: $Str .= ' onchange="document.'.$formName.'.submit()"';
445: }
446: $Str .= '>'."\n";
1.1 stredwic 447:
448: my $selected=0;
449:
450: foreach (@$students) {
451: $Str .= '<option';
452: if($selectedName eq $_) {
453: $Str .= ' selected';
454: $selected = 1;
455: }
456: $Str .= '>';
457: $Str .= $cache->{$_.':fullname'};
458: $Str .= '</option>'."\n";
459: }
460:
461: $Str .= '<option';
1.3 stredwic 462: if($selectedName eq 'No Student Selected') {
463: $Str .= ' selected';
464: $selected = 1;
465: }
466: $Str .= '>No Student Selected</option>'."\n";
467:
468: $Str .= '<option';
1.1 stredwic 469: if(!$selected) {
470: $Str .= ' selected';
471: }
1.3 stredwic 472: $Str .= '>All Students</option>'."\n";
1.1 stredwic 473:
474: $Str .= '</select>'."\n";
475:
476: return $Str;
477: }
478:
479: sub StatusOptions {
480: my ($status, $formName)=@_;
481:
482: my $OpSel1 = '';
483: my $OpSel2 = '';
484: my $OpSel3 = '';
485:
486: if($status eq 'Any') { $OpSel3 = ' selected'; }
487: elsif($status eq 'Expired' ) { $OpSel2 = ' selected'; }
488: else { $OpSel1 = ' selected'; }
489:
490: my $Str = '';
491: $Str .= '<select name="Status"';
492: if(defined($formName) && $formName ne '') {
493: $Str .= ' onchange="document.'.$formName.'.submit()"';
494: }
495: $Str .= '>'."\n";
496: $Str .= '<option'.$OpSel1.'>Active</option>'."\n";
497: $Str .= '<option'.$OpSel2.'>Expired</option>'."\n";
498: $Str .= '<option'.$OpSel3.'>Any</option>'."\n";
499: $Str .= '</select>'."\n";
500: }
501:
1.12 matthew 502:
503: ########################################################
504: ########################################################
505:
506: =pod
507:
508: =item &MultipleSectionSelect()
509:
510: Inputs:
511:
512: =over 4
513:
514: =item $sections A references to an array containing the names of all the
515: sections used in a class.
516:
517: =item $selectedSections A reference to an array containing the names of the
518: currently selected sections.
519:
520: =back
521:
522: Returns: a string containing HTML for a multiple select box for
523: selecting sections of a course.
524:
525: The form element name is 'Section'. @$sections is sorted prior to output.
526:
527: =cut
528:
529: ########################################################
530: ########################################################
1.5 stredwic 531: sub MultipleSectionSelect {
532: my ($sections,$selectedSections)=@_;
533:
534: my $Str = '';
1.7 stredwic 535: $Str .= '<select name="Section" multiple="true" size="4">'."\n";
1.5 stredwic 536:
1.11 minaeibi 537: foreach (sort @$sections) {
1.5 stredwic 538: $Str .= '<option';
539: foreach my $selected (@$selectedSections) {
540: if($_ eq $selected) {
541: $Str .= ' selected=""';
542: }
543: }
544: $Str .= '>'.$_.'</option>'."\n";
545: }
546: $Str .= '</select>'."\n";
1.12 matthew 547:
1.5 stredwic 548: return $Str;
549: }
550:
1.12 matthew 551: ########################################################
552: ########################################################
553:
554: =pod
555:
556: =item &Title()
557:
558: Inputs: $pageName a string containing the name of the page to be sent
559: to &Apache::loncommon::bodytag.
560:
561: Returns: string containing being <html> and complete <head> and <title>
562: as well as a <script> to focus the current window and change its width
563: and height to 500. Why? I do not know. If you find out, please update
564: this documentation.
565:
566: =cut
567:
568: ########################################################
569: ########################################################
1.1 stredwic 570: sub Title {
571: my ($pageName)=@_;
572:
573: my $Str = '';
574:
575: $Str .= '<html><head><title>'.$pageName.'</title></head>'."\n";
1.8 www 576: $Str .= &Apache::loncommon::bodytag($pageName)."\n";
1.1 stredwic 577: $Str .= '<script>window.focus(); window.width=500;window.height=500;';
578: $Str .= '</script>'."\n";
579:
580: return $Str;
581: }
582:
1.12 matthew 583: ########################################################
584: ########################################################
585:
1.1 stredwic 586: =pod
587:
1.13 matthew 588: =item &CreateHeadings()
1.1 stredwic 589:
590: This function generates the column headings for the chart.
591:
592: =over 4
593:
1.4 stredwic 594: Inputs: $CacheData, $keyID, $headings, $spacePadding
1.1 stredwic 595:
596: $CacheData: pointer to a hash tied to the cached data database
597:
1.4 stredwic 598: $keyID: a pointer to an array containing the names of the data
1.1 stredwic 599: held in a column and is used as part of a key into $CacheData
600:
601: $headings: The names of the headings for the student information
602:
603: $spacePadding: The spaces to go between columns
604:
605: Output: $Str
606:
607: $Str: A formatted string of the table column headings.
608:
609: =back
610:
611: =cut
612:
1.12 matthew 613: ########################################################
614: ########################################################
1.4 stredwic 615: sub CreateHeadings {
616: my ($data,$keyID,$headings,$displayString,$format)=@_;
1.1 stredwic 617: my $Str='';
1.4 stredwic 618: my $formatting = '';
1.1 stredwic 619:
620: for(my $index=0; $index<(scalar @$headings); $index++) {
1.4 stredwic 621: my $currentHeading=$headings->[$index];
622: if($format eq 'preformatted') {
623: my @dataLength=split(//,$currentHeading);
624: my $length=scalar @dataLength;
625: $formatting = (' 'x
626: ($data->{$keyID->[$index].':columnWidth'}-$length));
627: }
628: my $linkdata=$keyID->[$index];
629:
1.1 stredwic 630: my $tempString = $displayString;
631: $tempString =~ s/LINKDATA/$linkdata/;
1.4 stredwic 632: $tempString =~ s/DISPLAYDATA/$currentHeading/;
633: $tempString =~ s/FORMATTING/$formatting/;
634:
1.1 stredwic 635: $Str .= $tempString;
636: }
637:
638: return $Str;
639: }
640:
1.12 matthew 641: ########################################################
642: ########################################################
643:
1.1 stredwic 644: =pod
645:
646: =item &FormatStudentInformation()
647:
1.10 matthew 648: This function produces a formatted string of the student\'s information:
1.1 stredwic 649: username, domain, section, full name, and PID.
650:
651: =over 4
652:
1.4 stredwic 653: Input: $cache, $name, $keyID, $spacePadding
1.1 stredwic 654:
655: $cache: This is a pointer to a hash that is tied to the cached data
656:
657: $name: The name and domain of the current student in name:domain format
658:
1.4 stredwic 659: $keyID: A pointer to an array holding the names used to
1.1 stredwic 660:
661: remove data from the hash. They represent the name of the data to be removed.
662:
663: $spacePadding: Extra spaces that represent the space between columns
664:
665: Output: $Str
666:
667: $Str: Formatted string.
668:
669: =back
670:
671: =cut
672:
1.12 matthew 673: ########################################################
674: ########################################################
1.1 stredwic 675: sub FormatStudentInformation {
1.4 stredwic 676: my ($data,$name,$keyID,$displayString,$format)=@_;
1.1 stredwic 677: my $Str='';
1.4 stredwic 678: my $currentColumn;
679:
680: for(my $index=0; $index<(scalar @$keyID); $index++) {
681: $currentColumn=$data->{$name.':'.$keyID->[$index]};
1.1 stredwic 682:
1.4 stredwic 683: if($format eq 'preformatted') {
684: my @dataLength=split(//,$currentColumn);
685: my $length=scalar @dataLength;
686: $currentColumn.= (' 'x
687: ($data->{$keyID->[$index].':columnWidth'}-$length));
1.1 stredwic 688: }
689:
1.4 stredwic 690: my $tempString = $displayString;
691: $tempString =~ s/DISPLAYDATA/$currentColumn/;
692:
693: $Str .= $tempString;
1.1 stredwic 694: }
695:
696: return $Str;
1.7 stredwic 697: }
1.12 matthew 698:
699: ########################################################
700: ########################################################
1.7 stredwic 701:
702: # Create progress
703: sub Create_PrgWin {
1.14 albertel 704: my ($r, $title, $heading, $number_to_do)=@_;
1.7 stredwic 705: $r->print('<script>'.
706: "popwin=open(\'\',\'popwin\',\'width=400,height=100\');".
1.14 albertel 707: "popwin.document.writeln(\'<html><head><title>$title</title></head>".
708: "<body bgcolor=\"#88DDFF\">".
1.7 stredwic 709: "<h4>$heading</h4>".
710: "<form name=popremain>".
1.14 albertel 711: "<input type=text size=55 name=remaining value=Starting></form>".
1.7 stredwic 712: "</body></html>\');".
713: "popwin.document.close();".
714: "</script>");
715:
1.14 albertel 716: my %prog_state;
1.16 albertel 717: $prog_state{'done'}=0;
718: $prog_state{'firststart'}=time;
719: $prog_state{'laststart'}=time;
720: $prog_state{'max'}=$number_to_do;
1.14 albertel 721:
1.7 stredwic 722: $r->rflush();
1.14 albertel 723: return %prog_state;
1.7 stredwic 724: }
725:
726: # update progress
727: sub Update_PrgWin {
1.14 albertel 728: my ($r,$prog_state,$displayString)=@_;
1.7 stredwic 729: $r->print('<script>popwin.document.popremain.remaining.value="'.
730: $displayString.'";</script>');
1.16 albertel 731: $$prog_state{'laststart'}=time;
1.14 albertel 732: $r->rflush();
733: }
734:
735: # increment progress state
736: sub Increment_PrgWin {
737: my ($r,$prog_state,$extraInfo)=@_;
1.16 albertel 738: $$prog_state{'done'}++;
739: my $time_est= (time - $$prog_state{'firststart'})/$$prog_state{'done'} *
740: ($$prog_state{'max'}-$$prog_state{'done'});
741: $time_est = int($time_est);
742: if (int ($time_est/60) > 0) {
743: my $min = int($time_est/60);
744: my $sec = $time_est % 60;
745: $time_est = $min.' minutes';
746: if ($sec > 1) {
747: $time_est.= ', '.$sec.' seconds';
748: } elsif ($sec > 0) {
749: $time_est.= ', '.$sec.' second';
750: }
751: } else {
752: $time_est .= ' seconds';
753: }
1.19 matthew 754: my $lasttime = time-$$prog_state{'laststart'};
755: if ($lasttime == 1) {
756: $lasttime = '('.$lasttime.' second for '.$extraInfo.')';
757: } else {
758: $lasttime = '('.$lasttime.' seconds for '.$extraInfo.')';
759: }
1.14 albertel 760: $r->print('<script>popwin.document.popremain.remaining.value="'.
1.16 albertel 761: $$prog_state{'done'}.'/'.$$prog_state{'max'}.
1.19 matthew 762: ': '.$time_est.' remaining '.$lasttime.'";'.'</script>');
1.16 albertel 763: $$prog_state{'laststart'}=time;
1.7 stredwic 764: $r->rflush();
765: }
766:
767: # close Progress Line
768: sub Close_PrgWin {
1.14 albertel 769: my ($r,$prog_state)=@_;
1.7 stredwic 770: $r->print('<script>popwin.close()</script>'."\n");
1.14 albertel 771: undef(%$prog_state);
1.7 stredwic 772: $r->rflush();
1.1 stredwic 773: }
774:
775: 1;
776: __END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>