--- loncom/interface/lonhtmlcommon.pm 2002/07/26 16:22:09 1.5 +++ loncom/interface/lonhtmlcommon.pm 2010/06/10 09:09:59 1.277 @@ -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.277 2010/06/10 09:09:59 bisitz Exp $ # # Copyright Michigan State University Board of Trustees # @@ -25,245 +25,2602 @@ # # 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"; + foreach my $value (sort(keys(%recent))) { + unless ($value =~/^error\:/) { + my $escaped = &Apache::loncommon::escape_url($value); + &Apache::loncommon::inhibit_menu_check(\$escaped); + if ($area eq 'residx') { + next if ((!&Apache::lonnet::allowed('bre',$value)) && (!&Apache::lonnet::allowed('bro',$value))); + } + $return.="\n'; + } + } + $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; +} - $Str .= ''."\n"; + +=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 .= '}; + # 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"; - $Str .= 'Expired'."\n"; - $Str .= 'Any'."\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 .= ''."\n"; + if ($uri !~ m|/$|) { $output=~s|/$||; } + $output.=''; - return $Str; + return $output; } -sub Title { - my ($pageName)=@_; +# --------------------- A function that generates a window for the spellchecker - my $Str = ''; +sub spellheader { + my $start_page= + &Apache::loncommon::start_page('Speller Suggestions',undef, + {'only_body' => 1, + 'js_ready' => 1, + 'bgcolor' => '#DDDDDD', + 'add_entries' => { + 'onload' => + 'document.forms.spellcheckform.submit()', + } + }); + my $end_page= + &Apache::loncommon::end_page({'js_ready' => 1}); + + my $nothing=&javascript_nothing(); + return (< +// <\\/form>$end_page'); + checkwin.document.close(); +} +// END LON-CAPA Internal --> +// ]]> + +ENDCHECK +} - $Str .= ''.$pageName.''."\n"; - $Str .= ''."\n"; - $Str .= ''."\n"; - $Str .= '
'; - $Str .= '

Course: '; - $Str .= $ENV{'course.'.$ENV{'request.course.id'}.'.description'}; - $Str .= '

'."\n"; - $Str .= ''; - $Str .= '
'."\n"; +# ---------------------------------- Generate link to spell checker for a field - return $Str; +sub spelllink { + my ($form,$field)=@_; + my $linktext=&mt('Check Spelling'); + return (<$linktext +ENDLINK +} + +# ------------------------------------------------- Output headers for HTMLArea + +{ + my @htmlareafields; + sub init_htmlareafields { + undef(@htmlareafields); + } + + sub add_htmlareafields { + my (@newfields) = @_; + push(@htmlareafields,@newfields); + } + + sub get_htmlareafields { + return @htmlareafields; + } +} + +sub htmlareaheaders { + my $s=""; + if (&htmlareabrowser()) { + $s.=(< +ENDEDITOR + } + $s.=(< + + +ENDJQUERY + return $s; +} + +# ----------------------------------------------------------------- Preferences + +sub disablelink { + my @fields=@_; + if (defined($#fields)) { + unless ($#fields>=0) { return ''; } + } + return ''.&mt('Disable WYSIWYG Editor').''; +} + +sub enablelink { + my @fields=@_; + if (defined($#fields)) { + unless ($#fields>=0) { return ''; } + } + return ''.&mt('Enable WYSIWYG Editor').''; +} + +# ------------------------------------------------- lang to use in html editor +sub htmlarea_lang { + my $lang='en'; + if (&mt('htmlarea_lang') ne 'htmlarea_lang') { + $lang=&mt('htmlarea_lang'); + } + return $lang; +} + +# ----------------------------------------- Script to activate only some fields + +sub htmlareaselectactive { + my @fields=@_; + unless (&htmlareabrowser()) { return ''; } + my $output='
'; + return $output; +} + +# --------------------------------------------------------------------- Blocked + +sub htmlareablocked { + unless ($env{'environment.wysiwygeditor'} eq 'on') { return 1; } + return 0; +} + +# ---------------------------------------- Browser capable of running HTMLArea? + +sub htmlareabrowser { + return 1; } +############################################################ +############################################################ + =pod -=item &CreateTableHeadings() +=item breadcrumbs -This function generates the column headings for the chart. +Compiles the previously registered breadcrumbs into an series of links. +Additionally supports a 'component', which will be displayed on the +right side of the breadcrumbs enclosing div (without a link). +A link to help for the component will be included if one is specified. -=over 4 +All inputs can be undef without problems. + +Inputs: $component (the text on the right side of the breadcrumbs trail), + $component_help + $menulink (boolean, controls whether to include a link to /adm/menu) + $helplink (if 'nohelp' don't include the orange help link) + $css_class (optional name for the class to apply to the table for CSS) + $no_mt (optional flag, 1 if &mt() is _not_ to be applied to $component + when including the text on the right. +Returns a string containing breadcrumbs for the current page. -Inputs: $CacheData, $keyID, $headings, $spacePadding +=item clear_breadcrumbs -$CacheData: pointer to a hash tied to the cached data database +Clears the previously stored breadcrumbs. -$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 +=item add_breadcrumb -$headings: The names of the headings for the student information +Pushes a breadcrumb on the stack of crumbs. -$spacePadding: The spaces to go between columns +input: $breadcrumb, a hash reference. The keys 'href','title', and 'text' +are required. If present the keys 'faq' and 'bug' will be used to provide +links to the FAQ and bug sites. If the key 'no_mt' is present the 'title' +and 'text' values won't be sent through &mt() -Output: $Str +returns: nothing + +=cut -$Str: A formatted string of the table column headings. +############################################################ +############################################################ +{ + my @Crumbs; + my %tools = (); + + sub breadcrumbs { + my ($component,$component_help,$menulink,$helplink,$css_class,$no_mt, $CourseBreadcrumbs) = @_; + # + $css_class ||= 'LC_breadcrumbs'; + + # Make the faq and bug data cascade + my $faq = ''; + my $bug = ''; + my $help = ''; + # Crumb Symbol + my $crumbsymbol = '»'; + # The last breadcrumb does not have a link, so handle it separately. + my $last = pop(@Crumbs); + # + # The first one should be the course or a menu link + if (!defined($menulink)) { $menulink=1; } + if ($menulink) { + my $description = 'Menu'; + my $no_mt_descr = 0; + if ((exists($env{'request.course.id'})) && + ($env{'request.course.id'} ne '') && + ($env{'course.'.$env{'request.course.id'}.'.description'} ne '')) { + $description = + $env{'course.'.$env{'request.course.id'}.'.description'}; + $no_mt_descr = 1; + } + $menulink = { href =>'/adm/menu', + title =>'Go to main menu', + target =>'_top', + text =>$description, + no_mt =>$no_mt_descr, }; + if($last) { + #$last set, so we have some crumbs + unshift(@Crumbs,$menulink); + } else { + #only menulink crumb present + $last = $menulink; + } + } + my $links = join "", + map { + $faq = $_->{'faq'} if (exists($_->{'faq'})); + $bug = $_->{'bug'} if (exists($_->{'bug'})); + $help = $_->{'help'} if (exists($_->{'help'})); + + my $result = $_->{no_mt} ? $_->{text} : mt($_->{text}); + + if ($_->{href}){ + $result = htmltag( 'a', $result, + { href => $_->{href}, + title => $_->{no_mt} ? $_->{title} : mt($_->{title}), + target => $_->{target}, }); + } + + $result = htmltag( 'li', "$result $crumbsymbol"); + } @Crumbs; + + #should the last Element be translated? + + my $lasttext = $last->{'no_mt'} ? $last->{'text'} + : mt( $last->{'text'} ); + + # last breadcrumb is the first order heading of a page + # for course breadcrumbs it's just bold + $links .= htmltag( 'li', htmltag($CourseBreadcrumbs ? 'b' : 'h1', + $lasttext), {title => $lasttext}); + + my $icons = ''; + $faq = $last->{'faq'} if (exists($last->{'faq'})); + $bug = $last->{'bug'} if (exists($last->{'bug'})); + $help = $last->{'help'} if (exists($last->{'help'})); + $component_help=($component_help?$component_help:$help); +# if ($faq ne '') { +# $icons .= &Apache::loncommon::help_open_faq($faq); +# } +# if ($bug ne '') { +# $icons .= &Apache::loncommon::help_open_bug($bug); +# } + if ($faq ne '' || $component_help ne '' || $bug ne '') { + $icons .= &Apache::loncommon::help_open_menu($component, + $component_help, + $faq,$bug); + } + # + + + unless ($CourseBreadcrumbs) { + $links = htmltag('ol', $links, { id => "LC_MenuBreadcrumbs" }); + } else { + $links = htmltag('ul', $links, { class => "LC_CourseBreadcrumbs" }); + } + + if ($component) { + $links = htmltag('span', + ( $no_mt ? $component : mt($component) ). + ( $icons ? $icons : '' ), + { class => 'LC_breadcrumbs_component' } ) + .$links; + } + + render_tools(\$links); + $links = htmltag('div', $links, + { id => "LC_breadcrumbs" }) unless ($CourseBreadcrumbs) ; + render_advtools(\$links); + + # Return the @Crumbs stack to what we started with + push(@Crumbs,$last); + shift(@Crumbs); + # Return the breadcrumb's line + return "$links"; + } + + sub clear_breadcrumbs { + undef(@Crumbs); + undef(%tools); + } + + sub add_breadcrumb { + push(@Crumbs,@_); + } + +=item add_breadcrumb_tool($category, $html) + +Adds $html to $category of the breadcrumb toolbar container. + +$html is usually a link to a page that invokes a function on the currently +displayed data (e.g. print when viewing a problem) + +Currently there are 3 possible values for $category: + +=over + +=item navigation +left of breadcrumbs line + +=item tools +right of breadcrumbs line + +=item advtools +advanced tools shown in a separate box below breadcrumbs line =back + +returns: nothing + +=cut + + sub add_breadcrumb_tool { + my ($category, @html) = @_; + return unless @html; + if (!defined(%tools)) { + %tools = ( navigation => [], tools => [], advtools => []); + } + #this cleans data received from lonmenu::innerregister + @html = grep {defined $_ && $_ ne ''} @html; + for (@html) { + s/align="(right|left)"//; + s/// if $category ne 'advtools'; + } + + push @{$tools{$category}}, @html; + } + +=item clear_breadcrumb_tools() + +Clears the breadcrumb toolbar container. + +returns: nothing + +=cut + + sub clear_breadcrumb_tools { + undef(%tools); + } + +=item render_tools(\$breadcrumbs) + +Creates html for breadcrumb tools (categories navigation and tools) and inserts +\$breadcrumbs at the correct position. + +input: \$breadcrumbs - a reference to the string containing prepared +breadcrumbs. + +returns: nothing +=cut + +#TODO might split this in separate functions for each category + sub render_tools { + my ($breadcrumbs) = @_; + return unless defined %tools; + + my $navigation = list_from_array($tools{navigation}, + { listattr => { class=>"LC_breadcrumb_tools_navigation" } }); + my $tools = list_from_array($tools{tools}, + { listattr => { class=>"LC_breadcrumb_tools_tools" } }); + $$breadcrumbs = list_from_array([$navigation, $tools, $$breadcrumbs], + { listattr => { class=>'LC_breadcrumb_tools_outerlist' } }); + } + +=item render_advtools(\$breadcrumbs) + +Creates html for advanced tools (category advtools) and inserts \$breadcrumbs +at the correct position. + +input: \$breadcrumbs - a reference to the string containing prepared +breadcrumbs (after render_tools call). + +returns: nothing =cut -sub CreateHeadings { - my ($data,$keyID,$headings,$displayString,$format)=@_; - my $Str=''; - my $formatting = ''; + sub render_advtools { + my ($breadcrumbs) = @_; + return unless (defined $tools{'advtools'}) + and (scalar(@{$tools{'advtools'}}) > 0); + + $$breadcrumbs .= Apache::loncommon::head_subbox( + funclist_from_array($tools{'advtools'}) ); + } + +} # 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 end_pick_box { + shift(@row_count); + my $output = <<"END"; +
+END + return $output; +} + +sub row_headline { + my $output = <<"END"; + +END + return $output; +} + +sub row_title { + my ($title,$css_title_class,$css_value_class, $css_value_furtherAttributes) = @_; + $row_count[0]++; + my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row'; + $css_title_class ||= 'LC_pick_box_title'; + $css_title_class = 'class="'.$css_title_class.'"'; + + $css_value_class ||= 'LC_pick_box_value'; + + if ($title ne '') { + $title .= ':'; + } + my $output = <<"ENDONE"; + + + $title + + +ENDONE + return $output; +} + +sub row_closure { + my ($no_separator) =@_; + my $output = <<"ENDTWO"; + + +ENDTWO + if (!$no_separator) { + $output .= <<"ENDTWO"; + + + + +ENDTWO + } + return $output; +} + +} # End: row_count block for pick_box - 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)); +sub role_select_row { + my ($roles,$title,$css_class,$show_separate_custom,$cdom,$cnum) = @_; + my $crstype = 'Course'; + if ($cdom ne '' && $cnum ne '') { + $crstype = &Apache::loncommon::course_type($cdom.'_'.$cnum); + } + my $output; + if (defined($title)) { + $output = &row_title($title,$css_class); + } + $output .= qq| + \n|; + if (defined($title)) { + $output .= &row_closure(); + } + return $output; +} - my $tempString = $displayString; - $tempString =~ s/LINKDATA/$linkdata/; - $tempString =~ s/DISPLAYDATA/$currentHeading/; - $tempString =~ s/FORMATTING/$formatting/; +sub course_select_row { + my ($title,$formname,$totcodes,$codetitles,$idlist,$idlist_titles, + $css_class,$crstype) = @_; + my $output = &row_title($title,$css_class); + $output .= &course_selection($formname,$totcodes,$codetitles,$idlist,$idlist_titles,$crstype); + $output .= &row_closure(); + return $output; +} - $Str .= $tempString; +sub course_selection { + my ($formname,$totcodes,$codetitles,$idlist,$idlist_titles,$crstype) = @_; + my $output = qq| + + |; + + my ($allcrs,$pickspec); + if ($crstype eq 'Community') { + $allcrs = &mt('All communities'); + $pickspec = &mt('Pick specific communities:'); + } else { + $allcrs = &mt('All courses'); + $pickspec = &mt('Pick specific course(s):'); } - return $Str; + my $courseform=''.&Apache::loncommon::selectcourse_link + ($formname,'pickcourse','pickdomain','coursedesc','',1,$crstype).''; + $output .= ''.$allcrs.'
'; + 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 .= ''.$pickspec.' '.$courseform.'  selected.
'."\n"; + return $output; +} + +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; } +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; +} + + +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; +} + +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; +} + + +sub resource_info_box { + my ($symb,$onlyfolderflag)=@_; + my $return=''; + if ($symb) { + $return=&Apache::loncommon::start_data_table(); + my ($map,$id,$resource)=&Apache::lonnet::decode_symb($symb); + my $folder=&Apache::lonnet::gettitle($map); + $return.=&Apache::loncommon::start_data_table_row(). + ''.&mt('Folder:').''.$folder.''. + &Apache::loncommon::end_data_table_row(); + unless ($onlyfolderflag) { + $return.=&Apache::loncommon::start_data_table_row(). + ''.&mt('Resource:').''.&Apache::lonnet::gettitle($symb).''. + &Apache::loncommon::end_data_table_row(); + } + $return.=&Apache::loncommon::end_data_table(); + } else { + $return='

'.&mt('No context provided.').'

'; + } + return $return; + +} + +############################################## +############################################## + +# topic_bar +# +# Generates a div containing an (optional) number with a white background followed by a +# title with a background color defined in the corresponding CSS: LC_topic_bar +# Inputs: +# 1. number to display. +# If input for number is empty only the title will be displayed. +# 2. title text to display. +# Outputs - a scalar containing html mark-up for the div. + +sub topic_bar { + my ($num,$title) = @_; + my $number = ''; + if ($num ne '') { + $number = ''.$num.''; + } + return '
'.$number.$title.'
'; +} + +############################################## +############################################## +# 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). + + +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; +} + +############################################## +############################################## +# 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') || ($$elements{$name} eq 'hidden')) { + 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]| : 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, [start|end|both]); +# +# EXAMPLES: +# - scripttag("alert('Hello World!')", 'both') +# returns: +# +# +# NOTES: +# - works currently only for javascripts +# +# OUTPUT: +# Scriptcode properly enclosed in