Annotation of loncom/interface/lonhtmlcommon.pm, revision 1.21
1.2 www 1: # The LearningOnline Network with CAPA
2: # a pile of common html routines
3: #
1.21 ! matthew 4: # $Id: lonhtmlcommon.pm,v 1.20 2003/04/30 15:49:45 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:
1.21 ! matthew 308:
1.17 matthew 309: ##############################################
310: ##############################################
311:
1.21 ! matthew 312: =pod
1.17 matthew 313:
1.21 ! matthew 314: =item &StatusOptions()
1.10 matthew 315:
1.21 ! matthew 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'.
1.6 stredwic 318:
1.21 ! matthew 319: Inputs:
1.6 stredwic 320:
1.21 ! matthew 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.
1.6 stredwic 324:
1.21 ! matthew 325: $formname: The name of the form. If defined the onchange attribute of
! 326: the selection box is set to document.$formname.submit().
1.6 stredwic 327:
1.21 ! matthew 328: $size: the size (number of lines) of the selection box.
1.6 stredwic 329:
1.21 ! matthew 330: Returns: a perl string as described.
1.1 stredwic 331:
1.21 ! matthew 332: =cut
1.9 stredwic 333:
1.21 ! matthew 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'}));
1.9 stredwic 342: }
1.1 stredwic 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: }
1.21 ! matthew 357: $Str .= ' size="'.$size.'" ';
1.1 stredwic 358: $Str .= '>'."\n";
1.21 ! matthew 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";
1.1 stredwic 365: $Str .= '</select>'."\n";
366: }
367:
1.12 matthew 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: ########################################################
1.5 stredwic 397: sub MultipleSectionSelect {
398: my ($sections,$selectedSections)=@_;
399:
400: my $Str = '';
1.7 stredwic 401: $Str .= '<select name="Section" multiple="true" size="4">'."\n";
1.5 stredwic 402:
1.11 minaeibi 403: foreach (sort @$sections) {
1.5 stredwic 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";
1.12 matthew 413:
1.5 stredwic 414: return $Str;
415: }
416:
1.12 matthew 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: ########################################################
1.1 stredwic 436: sub Title {
437: my ($pageName)=@_;
438:
439: my $Str = '';
440:
441: $Str .= '<html><head><title>'.$pageName.'</title></head>'."\n";
1.8 www 442: $Str .= &Apache::loncommon::bodytag($pageName)."\n";
1.1 stredwic 443: $Str .= '<script>window.focus(); window.width=500;window.height=500;';
444: $Str .= '</script>'."\n";
445:
446: return $Str;
447: }
448:
1.12 matthew 449: ########################################################
450: ########################################################
451:
1.1 stredwic 452: =pod
453:
1.13 matthew 454: =item &CreateHeadings()
1.1 stredwic 455:
456: This function generates the column headings for the chart.
457:
458: =over 4
459:
1.4 stredwic 460: Inputs: $CacheData, $keyID, $headings, $spacePadding
1.1 stredwic 461:
462: $CacheData: pointer to a hash tied to the cached data database
463:
1.4 stredwic 464: $keyID: a pointer to an array containing the names of the data
1.1 stredwic 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:
1.12 matthew 479: ########################################################
480: ########################################################
1.4 stredwic 481: sub CreateHeadings {
482: my ($data,$keyID,$headings,$displayString,$format)=@_;
1.1 stredwic 483: my $Str='';
1.4 stredwic 484: my $formatting = '';
1.1 stredwic 485:
486: for(my $index=0; $index<(scalar @$headings); $index++) {
1.4 stredwic 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:
1.1 stredwic 496: my $tempString = $displayString;
497: $tempString =~ s/LINKDATA/$linkdata/;
1.4 stredwic 498: $tempString =~ s/DISPLAYDATA/$currentHeading/;
499: $tempString =~ s/FORMATTING/$formatting/;
500:
1.1 stredwic 501: $Str .= $tempString;
502: }
503:
504: return $Str;
505: }
506:
1.12 matthew 507: ########################################################
508: ########################################################
509:
1.1 stredwic 510: =pod
511:
512: =item &FormatStudentInformation()
513:
1.10 matthew 514: This function produces a formatted string of the student\'s information:
1.1 stredwic 515: username, domain, section, full name, and PID.
516:
517: =over 4
518:
1.4 stredwic 519: Input: $cache, $name, $keyID, $spacePadding
1.1 stredwic 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:
1.4 stredwic 525: $keyID: A pointer to an array holding the names used to
1.1 stredwic 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:
1.12 matthew 539: ########################################################
540: ########################################################
1.1 stredwic 541: sub FormatStudentInformation {
1.4 stredwic 542: my ($data,$name,$keyID,$displayString,$format)=@_;
1.1 stredwic 543: my $Str='';
1.4 stredwic 544: my $currentColumn;
545:
546: for(my $index=0; $index<(scalar @$keyID); $index++) {
547: $currentColumn=$data->{$name.':'.$keyID->[$index]};
1.1 stredwic 548:
1.4 stredwic 549: if($format eq 'preformatted') {
550: my @dataLength=split(//,$currentColumn);
551: my $length=scalar @dataLength;
552: $currentColumn.= (' 'x
553: ($data->{$keyID->[$index].':columnWidth'}-$length));
1.1 stredwic 554: }
555:
1.4 stredwic 556: my $tempString = $displayString;
557: $tempString =~ s/DISPLAYDATA/$currentColumn/;
558:
559: $Str .= $tempString;
1.1 stredwic 560: }
561:
562: return $Str;
1.7 stredwic 563: }
1.12 matthew 564:
565: ########################################################
566: ########################################################
1.7 stredwic 567:
568: # Create progress
569: sub Create_PrgWin {
1.14 albertel 570: my ($r, $title, $heading, $number_to_do)=@_;
1.7 stredwic 571: $r->print('<script>'.
572: "popwin=open(\'\',\'popwin\',\'width=400,height=100\');".
1.14 albertel 573: "popwin.document.writeln(\'<html><head><title>$title</title></head>".
574: "<body bgcolor=\"#88DDFF\">".
1.7 stredwic 575: "<h4>$heading</h4>".
576: "<form name=popremain>".
1.14 albertel 577: "<input type=text size=55 name=remaining value=Starting></form>".
1.7 stredwic 578: "</body></html>\');".
579: "popwin.document.close();".
580: "</script>");
581:
1.14 albertel 582: my %prog_state;
1.16 albertel 583: $prog_state{'done'}=0;
584: $prog_state{'firststart'}=time;
585: $prog_state{'laststart'}=time;
586: $prog_state{'max'}=$number_to_do;
1.14 albertel 587:
1.7 stredwic 588: $r->rflush();
1.14 albertel 589: return %prog_state;
1.7 stredwic 590: }
591:
592: # update progress
593: sub Update_PrgWin {
1.14 albertel 594: my ($r,$prog_state,$displayString)=@_;
1.7 stredwic 595: $r->print('<script>popwin.document.popremain.remaining.value="'.
596: $displayString.'";</script>');
1.16 albertel 597: $$prog_state{'laststart'}=time;
1.14 albertel 598: $r->rflush();
599: }
600:
601: # increment progress state
602: sub Increment_PrgWin {
603: my ($r,$prog_state,$extraInfo)=@_;
1.16 albertel 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: }
1.19 matthew 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: }
1.14 albertel 626: $r->print('<script>popwin.document.popremain.remaining.value="'.
1.16 albertel 627: $$prog_state{'done'}.'/'.$$prog_state{'max'}.
1.19 matthew 628: ': '.$time_est.' remaining '.$lasttime.'";'.'</script>');
1.16 albertel 629: $$prog_state{'laststart'}=time;
1.7 stredwic 630: $r->rflush();
631: }
632:
633: # close Progress Line
634: sub Close_PrgWin {
1.14 albertel 635: my ($r,$prog_state)=@_;
1.7 stredwic 636: $r->print('<script>popwin.close()</script>'."\n");
1.14 albertel 637: undef(%$prog_state);
1.7 stredwic 638: $r->rflush();
1.1 stredwic 639: }
640:
641: 1;
642: __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