--- loncom/interface/lonhtmlcommon.pm 2002/07/26 16:22:09 1.5
+++ loncom/interface/lonhtmlcommon.pm 2009/08/10 12:32:34 1.229
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common html routines
#
-# $Id: lonhtmlcommon.pm,v 1.5 2002/07/26 16:22:09 stredwic Exp $
+# $Id: lonhtmlcommon.pm,v 1.229 2009/08/10 12:32:34 droeschl Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -25,245 +25,2304 @@
#
# http://www.lon-capa.org/
#
+######################################################################
+######################################################################
+
+=pod
+
+=head1 NAME
+
+Apache::lonhtmlcommon - routines to do common html things
+
+=head1 SYNOPSIS
+
+Referenced by other mod_perl Apache modules.
+
+=head1 INTRODUCTION
+
+lonhtmlcommon is a collection of subroutines used to present information
+in a consistent html format, or provide other functionality related to
+html.
+
+=head2 General Subroutines
+
+=over 4
+
+=cut
+
+######################################################################
+######################################################################
package Apache::lonhtmlcommon;
use strict;
+use Time::Local;
+use Time::HiRes;
+use Apache::lonlocal;
+use Apache::lonnet;
+use LONCAPA;
-sub MapOptions {
- my ($data, $page)=@_;
- my $Str = '';
- $Str .= ''."\n";
+##############################################
+
+=pod
+
+=item dragmath_js
+
+Javascript used to open pop-up window containing dragmath applet which
+can be used to paste LaTeX into a textarea.
+
+=cut
+
+sub dragmath_js {
+ my ($popup) = @_;
+ return <
+ //
+
+
+ENDDRAGMATHJS
+}
+
+
+##############################################
+##############################################
+
+=pod
+
+=item authorbombs
+
+=cut
+
+##############################################
+##############################################
+
+sub authorbombs {
+ my $url=shift;
+ $url=&Apache::lonnet::declutter($url);
+ my ($udom,$uname)=($url=~m{^($LONCAPA::domain_re)/($LONCAPA::username_re)/});
+ my %bombs=&Apache::lonmsg::all_url_author_res_msg($uname,$udom);
+ foreach (keys %bombs) {
+ if ($_=~/^$udom\/$uname\//) {
+ return ''.
+ &Apache::loncommon::help_open_topic('About_Bombs');
+ }
+ }
+ return '';
+}
+
+##############################################
+##############################################
+
+sub recent_filename {
+ my $area=shift;
+ return 'nohist_recent_'.&escape($area);
+}
+
+sub store_recent {
+ my ($area,$name,$value,$freeze)=@_;
+ my $file=&recent_filename($area);
+ my %recent=&Apache::lonnet::dump($file);
+ if (scalar(keys(%recent))>20) {
+# remove oldest value
+ my $oldest=time();
+ my $delkey='';
+ foreach my $item (keys(%recent)) {
+ my $thistime=(split(/\&/,$recent{$item}))[0];
+ if (($thistime ne "always_include") && ($thistime<$oldest)) {
+ $oldest=$thistime;
+ $delkey=$item;
+ }
+ }
+ &Apache::lonnet::del($file,[$delkey]);
+ }
+# store new value
+ my $timestamp;
+ if ($freeze) {
+ $timestamp = "always_include";
+ } else {
+ $timestamp = time();
+ }
+ &Apache::lonnet::put($file,{ $name =>
+ $timestamp.'&'.&escape($value) });
+}
+
+sub remove_recent {
+ my ($area,$names)=@_;
+ my $file=&recent_filename($area);
+ return &Apache::lonnet::del($file,$names);
+}
+
+sub select_recent {
+ my ($area,$fieldname,$event)=@_;
+ my %recent=&Apache::lonnet::dump(&recent_filename($area));
+ my $return="\n\n";
+ return $return;
+}
+
+sub get_recent {
+ my ($area, $n) = @_;
+ my %recent=&Apache::lonnet::dump(&recent_filename($area));
+
+# Create hash with key as time and recent as value
+# Begin filling return_hash with any 'always_include' option
+ my %time_hash = ();
+ my %return_hash = ();
+ foreach my $item (keys %recent) {
+ my ($thistime,$thisvalue)=(split(/\&/,$recent{$item}));
+ if ($thistime eq 'always_include') {
+ $return_hash{$item} = &unescape($thisvalue);
+ $n--;
+ } else {
+ $time_hash{$thistime} = $item;
+ }
+ }
+
+# Sort by decreasing time and return key value pairs
+ my $idx = 1;
+ foreach my $item (reverse(sort(keys(%time_hash)))) {
+ $return_hash{$time_hash{$item}} =
+ &unescape((split(/\&/,$recent{$time_hash{$item}}))[1]);
+ if ($n && ($idx++ >= $n)) {last;}
+ }
+
+ return %return_hash;
+}
+
+sub get_recent_frozen {
+ my ($area) = @_;
+ my %recent=&Apache::lonnet::dump(&recent_filename($area));
+
+# Create hash with all 'frozen' items
+ my %return_hash = ();
+ foreach my $item (keys(%recent)) {
+ my ($thistime,$thisvalue)=(split(/\&/,$recent{$item}));
+ if ($thistime eq 'always_include') {
+ $return_hash{$item} = &unescape($thisvalue);
+ }
+ }
+ return %return_hash;
+}
+
+
+
+=pod
+=item textbox
+
+=cut
+
+##############################################
+##############################################
+sub textbox {
+ my ($name,$value,$size,$special) = @_;
+ $size = 40 if (! defined($size));
+ $value = &HTML::Entities::encode($value,'<>&"');
+ my $Str = '';
return $Str;
}
-sub StudentOptions {
- my ($cache, $students, $selectedName, $page, $formName)=@_;
+##############################################
+##############################################
- my $Str = '';
- $Str .= ''."\n";
}
-sub MultipleSectionSelect {
- my ($sections,$selectedSections)=@_;
+########################################################
+########################################################
- my $Str = '';
- $Str .= ''."\n";
+=pod
+
+=item Progess Window Handling Routines
+
+These routines handle the creation, update, increment, and closure of
+progress windows. The progress window reports to the user the number
+of items completed and an estimate of the time required to complete the rest.
+
+=over 4
+
+
+=item &Create_PrgWin
+
+Writes javascript to the client to open a progress window and returns a
+data structure used for bookkeeping.
+
+Inputs
+
+=over 4
+
+=item $r Apache request
+
+=item $title The title of the progress window
+
+=item $heading A description (usually 1 line) of the process being initiated.
+
+=item $number_to_do The total number of items being processed.
+
+=item $type Either 'popup' or 'inline' (popup is assumed if nothing is
+ specified)
+
+=item $width Specify the width in charaters of the input field.
+
+=item $formname Only useful in the inline case, if a form already exists, this needs to be used and specfiy the name of the form, otherwise the Progress line will be created in a new form of it's own
+
+=item $inputname Only useful in the inline case, if a form and an input of type text exists, use this to specify the name of the input field
+
+=back
+
+Returns a hash containing the progress state data structure.
+
+
+=item &Update_PrgWin
+
+Updates the text in the progress indicator. Does not increment the count.
+See &Increment_PrgWin.
+
+Inputs:
+
+=over 4
+
+=item $r Apache request
+
+=item $prog_state Pointer to the data structure returned by &Create_PrgWin
+
+=item $displaystring The string to write to the status indicator
+
+=back
+
+Returns: none
+
+
+=item Increment_PrgWin
+
+Increment the count of items completed for the progress window by 1.
+
+Inputs:
+
+=over 4
+
+=item $r Apache request
+
+=item $prog_state Pointer to the data structure returned by Create_PrgWin
+
+=item $extraInfo A description of the items being iterated over. Typically
+'student'.
+
+=back
- foreach (@$sections) {
- $Str .= ''."\n";
+
+ if ($component) {
+ $links = htmltag('span',
+ ( $no_mt ? $component : mt($component) ).
+ ( $icons ? $icons : '' ),
+ { class => 'LC_breadcrumbs_component' } )
+ .$links;
+ }
+
+ $links = htmltag('div', $links,
+ { id => "LC_breadcrumbs" }) unless ($CourseBreadcrumbs) ;
+
+ # Return the @Crumbs stack to what we started with
+ push(@Crumbs,$last);
+ shift(@Crumbs);
+ # Return the breadcrumb's line
+ return "$links";
}
- $Str .= ''."\n";
- return $Str;
+ sub clear_breadcrumbs {
+ undef(@Crumbs);
+ }
+
+ sub add_breadcrumb {
+ push (@Crumbs,@_);
+ }
+
+} # End of scope for @Crumbs
+
+############################################################
+############################################################
+
+# Nested table routines.
+#
+# Routines to display form items in a multi-row table with 2 columns.
+# Uses nested tables to divide form elements into segments.
+# For examples of use see loncom/interface/lonnotify.pm
+#
+# Can be used in following order: ...
+# &start_pick_box()
+# row1
+# row2
+# row3 ... etc.
+# &submit_row()
+# &end_pick_box()
+#
+# where row1, row 2 etc. are chosen from &role_select_row,&course_select_row,
+# &status_select_row and &email_default_row
+#
+# Can also be used in following order:
+#
+# &start_pick_box()
+# &row_title()
+# &row_closure()
+# &row_title()
+# &row_closure() ... etc.
+# &submit_row()
+# &end_pick_box()
+#
+# In general a &submit_row() call should proceed the call to &end_pick_box(),
+# as this routine adds a button for form submission.
+# &submit_row() does not require a &row_closure after it.
+#
+# &start_pick_box() creates a bounding table with 1-pixel wide black border.
+# rows should be placed between calls to &start_pick_box() and &end_pick_box.
+#
+# &row_title() adds a title in the left column for each segment.
+# &row_closure() closes a row with a 1-pixel wide black line.
+#
+# &role_select_row() provides a select box from which to choose 1 or more roles
+# &course_select_row provides ways of picking groups of courses
+# radio buttons: all, by category or by picking from a course picker pop-up
+# note: by category option is only displayed if a domain has implemented
+# selection by year, semester, department, number etc.
+#
+# &status_select_row() provides a select box from which to choose 1 or more
+# access types (current access, prior access, and future access)
+#
+# &email_default_row() provides text boxes for default e-mail suffixes for
+# different authentication types in a domain.
+#
+# &row_title() and &row_closure() are called internally by the &*_select_row
+# routines, but can also be called directly to start and end rows which have
+# needs that are not accommodated by the *_select_row() routines.
+
+{ # Start: row_count block for pick_box
+my @row_count;
+
+sub start_pick_box {
+ my ($css_class) = @_;
+ if (defined($css_class)) {
+ $css_class = 'class="'.$css_class.'"';
+ } else {
+ $css_class= 'class="LC_pick_box"';
+ }
+ unshift(@row_count,0);
+ my $output = <<"END";
+
+END
+ return $output;
}
-sub Title {
- my ($pageName)=@_;
+sub end_pick_box {
+ shift(@row_count);
+ my $output = <<"END";
+
+END
+ return $output;
+}
- my $Str = '';
+sub row_headline {
+ my $output = <<"END";
+
';
+ }
+ }
+ $output .= ''.&mt('Pick specific course(s):').' '.$courseform.' selected. '."\n";
+ return $output;
+}
-$CacheData: pointer to a hash tied to the cached data database
+sub status_select_row {
+ my ($types,$title,$css_class) = @_;
+ my $output;
+ if (defined($title)) {
+ $output = &row_title($title,$css_class,'LC_pick_box_select');
+ }
+ $output .= qq|
+ \n|;
+ foreach my $status_type (sort(keys(%{$types}))) {
+ $output .= ' ';
+ }
+ $output .= qq| \n|;
+ if (defined($title)) {
+ $output .= &row_closure();
+ }
+ return $output;
+}
-$keyID: a pointer to an array containing the names of the data
-held in a column and is used as part of a key into $CacheData
+sub email_default_row {
+ my ($authtypes,$title,$descrip,$css_class) = @_;
+ my $output = &row_title($title,$css_class);
+ $output .= $descrip.
+ &Apache::loncommon::start_data_table().
+ &Apache::loncommon::start_data_table_header_row().
+ '
'.
+ &Apache::loncommon::end_data_table_row();
+ }
+ $output .= &Apache::loncommon::end_data_table();
+ $output .= &row_closure();
+ return $output;
+}
-$headings: The names of the headings for the student information
-$spacePadding: The spaces to go between columns
+sub submit_row {
+ my ($title,$cmd,$submit_text,$css_class) = @_;
+ my $output = &row_title($title,$css_class,'LC_pick_box_submit');
+ $output .= qq|
+
+
+
+
+ \n|;
+ return $output;
+}
-Output: $Str
+sub course_custom_roles {
+ my ($cdom,$cnum) = @_;
+ my %returnhash=();
+ my %coursepersonnel=&Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
+ foreach my $person (sort(keys(%coursepersonnel))) {
+ my ($role) = ($person =~ /^([^:]+):/);
+ my ($end,$start) = split(/:/,$coursepersonnel{$person});
+ if ($end == -1 && $start == -1) {
+ next;
+ }
+ if ($role =~ m|^cr/[^/]+/[^/]+/[^/]|) {
+ $returnhash{$role} ++;
+ }
+ }
+ return %returnhash;
+}
-$Str: A formatted string of the table column headings.
-=back
+##############################################
+##############################################
-=cut
+# topic_bar
+#
+# Generates a div containing a numbered (static image) followed by a title
+# with a background color defined in the corresponding CSS: LC_topic_bar
+#
+sub topic_bar {
+ my ($imgnum,$title) = @_;
+ return '
'
+ .''
+ .' '.$title
+ .'
';
+}
-sub CreateHeadings {
- my ($data,$keyID,$headings,$displayString,$format)=@_;
- my $Str='';
- my $formatting = '';
-
- for(my $index=0; $index<(scalar @$headings); $index++) {
- my $currentHeading=$headings->[$index];
- if($format eq 'preformatted') {
- my @dataLength=split(//,$currentHeading);
- my $length=scalar @dataLength;
- $formatting = (' 'x
- ($data->{$keyID->[$index].':columnWidth'}-$length));
- }
- my $linkdata=$keyID->[$index];
-
- my $tempString = $displayString;
- $tempString =~ s/LINKDATA/$linkdata/;
- $tempString =~ s/DISPLAYDATA/$currentHeading/;
- $tempString =~ s/FORMATTING/$formatting/;
+##############################################
+##############################################
+
+# echo_form_input
+#
+# Generates html markup to add form elements from the referrer page
+# as hidden form elements (values encoded) in the new page.
+#
+# Intended to support two types of use
+# (a) to allow backing up to earlier pages in a multi-page
+# form submission process using a breadcrumb trail.
+#
+# (b) to allow the current page to be reloaded with form elements
+# set on previous page to remain unchanged. An example would
+# be where the a page containing a dynamically-built table of data is
+# is to be redisplayed, with only the sort order of the data changed.
+#
+# Inputs:
+# 1. Reference to array of form elements in the submitted form on
+# the referrer page which are to be excluded from the echoed elements.
+#
+# 2. Reference to array of regular expressions, which if matched in the
+# name of the form element n the referrer page will be omitted from echo.
+#
+# Outputs: A scalar containing the html markup for the echoed form
+# elements (all as hidden elements, with values encoded).
- $Str .= $tempString;
+
+sub echo_form_input {
+ my ($excluded,$regexps) = @_;
+ my $output = '';
+ foreach my $key (keys(%env)) {
+ if ($key =~ /^form\.(.+)$/) {
+ my $name = $1;
+ my $match = 0;
+ if ((!@{$excluded}) || (!grep/^$name$/,@{$excluded})) {
+ if (defined($regexps)) {
+ if (@{$regexps} > 0) {
+ foreach my $regexp (@{$regexps}) {
+ if ($name =~ /\Q$regexp\E/) {
+ $match = 1;
+ last;
+ }
+ }
+ }
+ }
+ if (!$match) {
+ if (ref($env{$key})) {
+ foreach my $value (@{$env{$key}}) {
+ $value = &HTML::Entities::encode($value,'<>&"');
+ $output .= ''."\n";
+ }
+ } else {
+ my $value = &HTML::Entities::encode($env{$key},'<>&"');
+ $output .= ''."\n";
+ }
+ }
+ }
+ }
}
+ return $output;
+}
- return $Str;
+##############################################
+##############################################
+
+# set_form_elements
+#
+# Generates javascript to set form elements to values based on
+# corresponding values for the same form elements when the page was
+# previously submitted.
+#
+# Last submission values are read from hidden form elements in referring
+# page which have the same name, i.e., generated by &echo_form_input().
+#
+# Intended to be called by onload event.
+#
+# Inputs:
+# (a) Reference to hash of echoed form elements to be set.
+#
+# In the hash, keys are the form element names, and the values are the
+# element type (selectbox, radio, checkbox or text -for textbox, textarea or
+# hidden).
+#
+# (b) Optional reference to hash of stored elements to be set.
+#
+# If the page being displayed is a page which permits modification of
+# previously stored data, e.g., the first page in a multi-page submission,
+# then if stored is supplied, form elements will be set to the last stored
+# values. If user supplied values are also available for the same elements
+# these will replace the stored values.
+#
+# Output:
+#
+# javascript function - set_form_elements() which sets form elements,
+# expects an argument: formname - the name of the form according to
+# the DOM, e.g., document.compose
+
+sub set_form_elements {
+ my ($elements,$stored) = @_;
+ my %values;
+ my $output .= 'function setFormElements(courseForm) {
+';
+ if (defined($stored)) {
+ foreach my $name (keys(%{$stored})) {
+ if (exists($$elements{$name})) {
+ if (ref($$stored{$name}) eq 'ARRAY') {
+ $values{$name} = $$stored{$name};
+ } else {
+ @{$values{$name}} = ($$stored{$name});
+ }
+ }
+ }
+ }
+
+ foreach my $key (keys(%env)) {
+ if ($key =~ /^form\.(.+)$/) {
+ my $name = $1;
+ if (exists($$elements{$name})) {
+ @{$values{$name}} = &Apache::loncommon::get_env_multiple($key);
+ }
+ }
+ }
+
+ foreach my $name (keys(%values)) {
+ for (my $i=0; $i<@{$values{$name}}; $i++) {
+ $values{$name}[$i] = &HTML::Entities::decode($values{$name}[$i],'<>&"');
+ $values{$name}[$i] =~ s/([\r\n\f]+)/\\n/g;
+ $values{$name}[$i] =~ s/"/\\"/g;
+ }
+ if ($$elements{$name} eq 'text') {
+ my $numvalues = @{$values{$name}};
+ if ($numvalues > 1) {
+ my $valuestring = join('","',@{$values{$name}});
+ $output .= qq|
+ var textvalues = new Array ("$valuestring");
+ var total = courseForm.elements['$name'].length;
+ if (total > $numvalues) {
+ total = $numvalues;
+ }
+ for (var i=0; i= 0) {
+ return true;
+ }
+ return false;
+ }
+}
+END
+ return $scripttag;
+}
+
+
+# USAGE: htmltag(element, content, {attribute => value,...});
+#
+# EXAMPLES:
+# - htmltag('a', 'this is an anchor', {href => 'www.example.com',
+# title => 'this is a title'})
+#
+# - You might want to set up needed tags like:
+#
+# my $h3 = sub { return htmltag( "h3", @_ ) };
+#
+# ... and use them: $h3->("This is a headline")
+#
+# - To set up a couple of tags, see sub inittags
+#
+# NOTES:
+# - Empty elements, such as are correctly terminated,
+# i.e. htmltag('br') returns
+# - Empty attributes (title="") are filtered out.
+# - The function will not check for deprecated attributes.
+#
+# OUTPUT: content enclosed in xhtml conform tags
+sub htmltag{
+ return
+ qq|<$_[0]|
+ . join( '', map { qq| $_="${$_[2]}{$_}"| if ${$_[2]}{$_} } keys %{ $_[2] } )
+ . ($_[1] ? qq|>$_[1]$_[0]>| : qq|/>|). "\n";
+};
+
+
+# USAGE: inittags(@tags);
+#
+# EXAMPLES:
+# - my ($h1, $h2, $h3) = initTags( qw( h1 h2 h3 ) )
+# $h1->("This is a headline") #Returns:
This is a headline
+#
+# NOTES: See sub htmltag for further information.
+#
+# OUTPUT: List of subroutines.
+sub inittags {
+ my @tags = @_;
+ return map { my $tag = $_;
+ sub { return htmltag( $tag, @_ ) }
+ } @tags;
+}
+
+
+# USAGE: scripttag(scriptcode, true/false);
+#
+# EXAMPLES:
+# - scripttag("alert('Hello World!')")
+#
+# NOTES:
+# - works currently only for javascripts
+#
+# OUTPUT: Scriptcode properly enclosed in