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