--- loncom/interface/lonhtmlcommon.pm 2002/08/30 15:35:08 1.9 +++ loncom/interface/lonhtmlcommon.pm 2009/06/16 15:17:12 1.225 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common html routines # -# $Id: lonhtmlcommon.pm,v 1.9 2002/08/30 15:35:08 stredwic Exp $ +# $Id: lonhtmlcommon.pm,v 1.225 2009/06/16 15:17:12 bisitz Exp $ # # Copyright Michigan State University Board of Trustees # @@ -25,370 +25,2285 @@ # # 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; + +############################################## +############################################## + +=pod + +=item confirm_success + +Successful completion of an operation message -sub AscendOrderOptions { - my ($order, $page, $formName)=@_; +=cut + +sub confirm_success { + my ($message,$failure)=@_; + if ($failure) { + return ''."\n" + .''.&mt('Error').' '."\n" + .$message."\n" + .''."\n"; + } else { + return ''."\n" + .''.&mt('Ok').' '."\n" + .$message."\n" + .''."\n"; + } +} + +############################################## +############################################## + +=pod + +=item dragmath_button + +Creates a button that launches a dragmath popup-window, in which an +expression can be edited and pasted as LaTeX into a specified textarea. + + textarea - Name of the textarea to edit. + helpicon - If true, show a help icon to the right of the button. - my $OpSel1 = ''; - my $OpSel2 = ''; +=cut + +sub dragmath_button { + my ($textarea,$helpicon) = @_; + my $help_text; + if ($helpicon) { + $help_text = &Apache::loncommon::help_open_topic('Authoring_Math_Editor'); + } + my $buttontext=&mt('Edit Math'); + return <$help_text +ENDDRAGMATH +} + +############################################## - if($order eq 'Ascending') { - $OpSel1 = ' selected'; +=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 ''.&mt('Bomb').''. + &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 { - $OpSel2 = ' selected'; + $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; +} - my $Str = ''; - $Str .= ''."\n"; + 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 MapOptions { - my ($data, $page, $formName)=@_; - my $Str = ''; - $Str .= '}; + # Month + my @Months = qw/January February March April May June + July August September October November December/; + # Pad @Months with a bogus value to make indexing easier + unshift(@Months,'If you can read this an error occurred'); + if ($includeempty) { $monthselector.=""; } + for(my $m = 1;$m <=$#Months;$m++) { + $monthselector .= qq{ '."\n"; - } + foreach my $type (['Active', &mt('Currently Has Access')], + ['Future', &mt('Will Have Future Access')], + ['Expired', &mt('Previously Had Access')], + ['Any', &mt('Any Access Status')]) { + my ($name,$label) = @$type; + $Str .= ''."\n"; - $Str .= 'Expired'."\n"; - $Str .= 'Any'."\n"; - $Str .= ''."\n"; + my $output = <<"ENDONE"; + + + $title + + +ENDONE + return $output; } -sub MultipleSectionSelect { - my ($sections,$selectedSections)=@_; +sub row_closure { + my ($no_separator) =@_; + my $output = <<"ENDTWO"; + + +ENDTWO + if (!$no_separator) { + $output .= <<"ENDTWO"; + + + + +ENDTWO + } + return $output; +} - my $Str = ''; - $Str .= ''."\n"; + $output .= qq| \n|; + if (defined($title)) { + $output .= &row_closure(); + } + return $output; +} - return $Str; +sub course_select_row { + my ($title,$formname,$totcodes,$codetitles,$idlist,$idlist_titles, + $css_class) = @_; + my $output = &row_title($title,$css_class); + $output .= &course_selection($formname,$totcodes,$codetitles,$idlist,$idlist_titles); + $output .= &row_closure(); + return $output; } -sub Title { - my ($pageName)=@_; +sub course_selection { + my ($formname,$totcodes,$codetitles,$idlist,$idlist_titles) = @_; + my $output = qq| + + |; + my $courseform=''.&Apache::loncommon::selectcourse_link + ($formname,'pickcourse','pickdomain','coursedesc','',1).''; + $output .= ''.&mt('All courses').'
'; + if ($totcodes > 0) { + my $numtitles = @$codetitles; + if ($numtitles > 0) { + $output .= ''.&mt('Pick courses by category:').'
'; + $output .= ''; + for (my $i=1; $i<$numtitles; $i++) { + $output .= ''; + } + $output .= '
'.$$codetitles[0].'
'."\n". + '
'.$$codetitles[$i].'
'."\n". + ''."\n". + '

'; + } + } + $output .= ''.&mt('Pick specific course(s):').' '.$courseform.'  selected.
'."\n"; + return $output; +} - my $Str = ''; +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|; + if (defined($title)) { + $output .= &row_closure(); + } + return $output; +} - $Str .= ''.$pageName.''."\n"; - $Str .= &Apache::loncommon::bodytag($pageName)."\n"; - $Str .= ''."\n"; +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(). + ''.&mt('Authentication Method').''. + ''.&mt('Username -> e-mail conversion').''."\n". + &Apache::loncommon::end_data_table_header_row(); + my $rownum = 0; + foreach my $auth (sort(keys(%{$authtypes}))) { + my ($userentry,$size); + if ($auth =~ /^krb/) { + $userentry = ''; + $size = 25; + } else { + $userentry = 'username@'; + $size = 15; + } + $output .= &Apache::loncommon::start_data_table_row(). + ' '.$$authtypes{$auth}.''. + ''.$userentry. + ''. + &Apache::loncommon::end_data_table_row(); + } + $output .= &Apache::loncommon::end_data_table(); + $output .= &row_closure(); + return $output; +} - return $Str; + +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; } -=pod +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; +} -=item &CreateTableHeadings() -This function generates the column headings for the chart. +############################################## +############################################## -=over 4 +# 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 '
' + .''.&mt('Step [_1]',$imgnum).'' + .' '.$title + .'
'; +} -Inputs: $CacheData, $keyID, $headings, $spacePadding +############################################## +############################################## + +# 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). -$CacheData: pointer to a hash tied to the cached data database -$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 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; +} -$headings: The names of the headings for the student information +############################################## +############################################## + +# 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}); + } + } + } + } -$spacePadding: The spaces to go between columns + foreach my $key (keys(%env)) { + if ($key =~ /^form\.(.+)$/) { + my $name = $1; + if (exists($$elements{$name})) { + @{$values{$name}} = &Apache::loncommon::get_env_multiple($key); + } + } + } -Output: $Str + 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; +} -=cut -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/; +# 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]| : 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; +} + + +############################################## +############################################## + +# generate_menu +# +# Generates html markup for a menu. +# +# Inputs: +# An array of following structure: +# ({ categorytitle => 'Categorytitle', +# items => [ +# { +# linktext => 'Text to be displayed', +# url => 'URL the link is pointing to, i.e. /adm/site?action=dosomething', +# permission => 'Contains permissions as returned from lonnet::allowed(), +# must evaluate to true in order to activate the link', +# icon => 'icon filename', +# alttext => 'alt text for the icon', +# help => 'Name of the corresponding helpfile', +# linktitle => 'Description of the link (used for title tag)' +# }, +# ... +# ] +# }, +# ... +# ) +# +# Outputs: A scalar containing the html markup for the menu. + +# ---- Remove when done ---- +# This routine is part of the redesign of LON-CAPA and it's +# subject to change during this project. +# Don't rely on its current functionality as it might be +# changed or removed. +# -------------------------- +sub generate_menu { + my @menu = @_; + # subs for specific html elements + my ($h3, $div, $ul, $li, $a, $img) = inittags( qw(h3 div ul li a img) ); + + my @categories; # each element represents the entire markup for a category + + foreach my $category (@menu) { + my @links; # contains the links for the current $category + foreach my $link (@{$$category{items}}) { + next unless $$link{permission}; + + # create the markup for the current $link and push it into @links. + # each entry consists of an image and a text optionally followed + # by a help link. + push @links, $li->( + $a->( + $img->("", { + class => "LC_noBorder LC_middle", + src => "/res/adm/pages/$$link{icon}", + alt => mt(defined($$link{alttext}) ? + $$link{alttext} : $$link{linktext}) + }), { + href => $$link{url}, + title => mt($$link{linktitle}) + }). + $a->(mt($$link{linktext}), { + href => $$link{url}, + title => mt($$link{linktitle}), + class => "LC_menubuttons_link" + }). + (defined($$link{help}) ? + Apache::loncommon::help_open_topic($$link{help}) : ''), + {class => "LC_menubuttons_inline_text"}); + } - $Str .= $tempString; + # wrap categorytitle in

, concatenate with + # joined and in
    tags wrapped @links + # and wrap everything in an enclosing
    and push it into + # @categories + # such that each element looks like: + #

    title

    • ...
    • ...
    + # the category won't be added if there aren't any links + push @categories, + $div->($h3->(mt($$category{categorytitle}), {class=>"LC_hcell"}). + $ul->(join('' ,@links), {class =>"LC_ListStyleNormal" }), + {class=>"LC_Box LC_400Box"}) if scalar(@links); } - return $Str; + # wrap the joined @categories in another
    (column layout) + return $div->(join('', @categories), {class => "LC_columnSection"}); } +############################################## +############################################## + =pod -=item &FormatStudentInformation() +=item &start_funclist + +Start list of available functions + +Typically used to offer a simple list of available functions +at top or bottom of page. +All available functions/actions for the current page +should be included in this list. + +If the optional headline text is not provided, a default text will be used. -This function produces a formatted string of the student's information: -username, domain, section, full name, and PID. +Related routines: =over 4 +add_item_funclist +end_funclist +=back + + +Inputs: (optional) headline text + +Returns: HTML code with function list start -Input: $cache, $name, $keyID, $spacePadding +=cut -$cache: This is a pointer to a hash that is tied to the cached data +############################################## +############################################## -$name: The name and domain of the current student in name:domain format +sub start_funclist { + my($legendtext)=@_; + $legendtext=&mt('Functions') if !$legendtext; + return "
    \n$legendtext\n" + .'
      '."\n"; +} -$keyID: A pointer to an array holding the names used to -remove data from the hash. They represent the name of the data to be removed. +############################################## +############################################## -$spacePadding: Extra spaces that represent the space between columns +=pod -Output: $Str +=item &add_item_funclist -$Str: Formatted string. +Adds an item to the list of available functions +Related routines: +=over 4 +start_funclist +end_funclist =back +Inputs: content item with text and link to function + +Returns: HTML code with list item for funclist + =cut -sub FormatStudentInformation { - my ($data,$name,$keyID,$displayString,$format)=@_; - my $Str=''; - my $currentColumn; +############################################## +############################################## - for(my $index=0; $index<(scalar @$keyID); $index++) { - $currentColumn=$data->{$name.':'.$keyID->[$index]}; +sub add_item_funclist { + my($content) = @_; + return '
    • '.$content.'
    • '."\n"; +} - if($format eq 'preformatted') { - my @dataLength=split(//,$currentColumn); - my $length=scalar @dataLength; - $currentColumn.= (' 'x - ($data->{$keyID->[$index].':columnWidth'}-$length)); - } +############################################## +############################################## - my $tempString = $displayString; - $tempString =~ s/DISPLAYDATA/$currentColumn/; +=pod - $Str .= $tempString; - } +=item &end_funclist - return $Str; -} +End list of available functions -# Create progress -sub Create_PrgWin { - my ($r, $title, $heading)=@_; - $r->print('"); +Related routines: +=over 4 +start_funclist +add_item_funclist +=back - $r->rflush(); -} +Inputs: ./. -# update progress -sub Update_PrgWin { - my ($displayString,$r)=@_; - $r->print(''); - $r->rflush(); -} +Returns: HTML code with function list end -# close Progress Line -sub Close_PrgWin { - my ($r)=@_; - $r->print(''."\n"); - $r->rflush(); +=cut + +############################################## +############################################## + +sub end_funclist { + my($r)=@_; + return "
    \n
    \n"; } 1; + __END__