--- loncom/interface/lonhtmlcommon.pm 2010/01/23 22:26:27 1.182.2.3 +++ loncom/interface/lonhtmlcommon.pm 2009/12/22 17:27:28 1.257 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common html routines # -# $Id: lonhtmlcommon.pm,v 1.182.2.3 2010/01/23 22:26:27 raeburn Exp $ +# $Id: lonhtmlcommon.pm,v 1.257 2009/12/22 17:27:28 faziophi Exp $ # # Copyright Michigan State University Board of Trustees # @@ -63,6 +63,47 @@ use Apache::lonnet; use LONCAPA; +sub coursepreflink { + my ($text,$category)=@_; + if (&Apache::lonnet::allowed('opa',$env{'request.course.id'})) { + return ''.$text.''; + } else { + return ''; + } +} + +sub raw_href_to_link { + my ($message)=@_; + $message=~s/(https?\:\/\/[^\s\'\"]+)(\s|$)/$1<\/tt><\/a>$2/gi; + return $message; +} + +############################################## +############################################## + +=pod + +=item confirm_success + +Successful completion of an operation message + +=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"; + } +} + ############################################## ############################################## @@ -86,7 +127,7 @@ sub dragmath_button { } my $buttontext=&mt('Edit Math'); return <$help_text + $help_text ENDDRAGMATH } @@ -105,11 +146,13 @@ sub dragmath_js { my ($popup) = @_; return < + // ENDDRAGMATHJS @@ -133,10 +176,10 @@ sub authorbombs { $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\//) { + foreach my $bomb (keys(%bombs)) { + if ($bomb =~ /^$udom\/$uname\//) { return ''. + '">'.&mt('Bomb').''. &Apache::loncommon::help_open_topic('About_Bombs'); } } @@ -195,6 +238,9 @@ sub select_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'; @@ -212,7 +258,7 @@ sub get_recent { # Begin filling return_hash with any 'always_include' option my %time_hash = (); my %return_hash = (); - foreach my $item (keys %recent) { + foreach my $item (keys(%recent)) { my ($thistime,$thisvalue)=(split(/\&/,$recent{$item})); if ($thistime eq 'always_include') { $return_hash{$item} = &unescape($thisvalue); @@ -285,7 +331,7 @@ sub checkbox { $Str .= 'value="'.$value.'"'; } if ($checked) { - $Str .= ' checked="1"'; + $Str .= ' checked="checked"'; } $Str .= ' />'; return $Str; @@ -307,7 +353,7 @@ sub radio { $Str .= 'value="'.$value.'"'; } if ($checked eq $value) { - $Str .= ' checked="1"'; + $Str .= ' checked="checked"'; } $Str .= ' />'; return $Str; @@ -337,7 +383,8 @@ dname_hour, dname_min, and dname_sec. The current setting for this time parameter. A unix format time (time in seconds since the beginning of Jan 1st, 1970, GMT. -An undefined value is taken to indicate the value is the current time. +An undefined value is taken to indicate the value is the current time +unless it is requested to leave it empty. See $includeempty. Also, to be explicit, a value of 'now' also indicates the current time. =item $special @@ -347,6 +394,9 @@ the date_setter. See lonparmset for exa =item $includeempty +If it is set (true) and no date/time value is provided, +the date/time fields are left empty. + =item $state Specifies the initial state of the form elements. Either 'disabled' or empty. @@ -366,7 +416,11 @@ sub date_setter { my ($formname,$dname,$currentvalue,$special,$includeempty,$state, $no_hh_mm_ss,$defhour,$defmin,$defsec,$nolink) = @_; my $now = time; - my $wasdefined=1; + + my $tzname; + my ($sec,$min,$hour,$mday,$month,$year) = ('', '', undef,''.''.''); + #other potentially useful values: wkday,yrday,is_daylight_savings + if (! defined($state) || $state ne 'disabled') { $state = ''; } @@ -374,37 +428,29 @@ sub date_setter { $no_hh_mm_ss = 0; } if ($currentvalue eq 'now') { - $currentvalue = $now; + $currentvalue = $now; } - if ((!defined($currentvalue)) || ($currentvalue eq '')) { - $wasdefined=0; - if ($includeempty) { - $currentvalue = 0; - } else { - $currentvalue = $now; - } + + # Default value: Set empty date field to current time + # unless empty inclusion is requested + if ((!$includeempty) && (!$currentvalue)) { + $currentvalue = $now; } - # other potentially useful values: wkday,yrday,is_daylight_savings - my $tzname; - my ($sec,$min,$hour,$mday,$month,$year)=('','',undef,'','',''); + # Do we have a date? Split it! if ($currentvalue) { - ($tzname,$sec,$min,$hour,$mday,$month,$year) = &get_timedates($currentvalue); - } - unless ($wasdefined) { - if (($defhour) || ($defmin) || ($defsec)) { - ($tzname,$sec,$min,$hour,$mday,$month,$year) = &get_timedates($now); - $sec=($defsec?$defsec:0); - $min=($defmin?$defmin:0); - $hour=($defhour?$defhour:0); - } elsif (!$includeempty) { - $sec=0; - $min=0; - $hour=0; - } + ($tzname,$sec,$min,$hour,$mday,$month,$year) = &get_timedates($currentvalue); + + #No values provided for hour, min, sec? Use default 0 + if (($defhour) || ($defmin) || ($defsec)) { + $sec = ($defsec ? $defsec : 0); + $min = ($defmin ? $defmin : 0); + $hour = ($defhour ? $defhour : 0); + } } my $result = "\n\n"; $result .= < +// ENDJS - $result .= ' '; + $result .= ' '; my $monthselector = qq{'; # Day my $dayselector = qq{}; # Year - my $yearselector = qq{}; + my $yearselector = qq{}; # my $hourselector = qq{<\\/form>'.$end_page. "\');". "popwin.document.close();}". - "\nwindow.setTimeout(openpopwin,0)"); + "\nwindow.setTimeout(openpopwin,0)" + )); $prog_state{'formname'}='popremain'; $prog_state{'inputname'}="remaining"; } elsif ($type eq 'inline') { @@ -993,10 +1041,12 @@ sub Create_PrgWin { # update progress sub Update_PrgWin { my ($r,$prog_state,$displayString)=@_; - &r_print($r,''); + &r_print($r,&Apache::lonhtmlcommon::scripttag( + $$prog_state{'window'}.'.document.'. + $$prog_state{'formname'}.'.'. + $$prog_state{'inputname'}.'.value="'. + $displayString.'";' + )); $$prog_state{'laststart'}=&Time::HiRes::time(); } @@ -1049,11 +1099,13 @@ sub Increment_PrgWin { if ($user_browser eq 'explorer' && $user_os =~ 'mac') { $lasttime = ''; } - &r_print($r,''); + &r_print($r,&Apache::lonhtmlcommon::scripttag( + $$prog_state{'window'}.'.document.'. + $$prog_state{'formname'}.'.'. + $$prog_state{'inputname'}.'.value="'. + $$prog_state{'done'}.'/'.$$prog_state{'max'}. + ': '.$time_est.' '.&mt('remaining').' '.$lasttime.'";' + )); $$prog_state{'laststart'}=&Time::HiRes::time(); } @@ -1061,7 +1113,9 @@ sub Increment_PrgWin { sub Close_PrgWin { my ($r,$prog_state)=@_; if ($$prog_state{'type'} eq 'popup') { - &r_print($r,''."\n"); + &r_print($r,&Apache::lonhtmlcommon::scripttag( + 'popwin.close()' + )); } elsif ($$prog_state{'type'} eq 'inline') { &Update_PrgWin($r,$prog_state,&mt('Done')); } @@ -1081,47 +1135,45 @@ sub r_print { # ------------------------------------------------------- Puts directory header sub crumbs { - my ($uri,$target,$prefix,$form,$size,$noformat,$skiplast)=@_; - if (! defined($size)) { - $size = '+2'; - } + my ($uri,$target,$prefix,$form,$skiplast)=@_; if ($target) { $target = ' target="'. &Apache::loncommon::escape_single($target).'"'; } - my $output=''; - unless ($noformat) { $output.='
'; } - $output.=''.$prefix.'/'; + my $output=''; + $output.=$prefix.'/'; if (($env{'user.adv'}) || ($env{'user.author'})) { - my $path=$prefix.'/'; - foreach my $dir (split('/',$uri)) { + my $path=$prefix.'/'; + foreach my $dir (split('/',$uri)) { if (! $dir) { next; } $path .= $dir; - if ($path eq $uri) { - if ($skiplast) { - $output.=$dir; + if ($path eq $uri) { + if ($skiplast) { + $output.=$dir; last; - } - } else { - $path.='/'; - } + } + } else { + $path.='/'; + } my $href_path = &HTML::Entities::encode($path,'<>&"'); - &Apache::loncommon::inhibit_menu_check(\$href_path); - if ($form) { - my $href = 'javascript:'.$form.".action='".$href_path."';".$form.'.submit();'; - $output.=qq{$dir/}; - } else { - $output.=qq{$dir/}; - } - } + &Apache::loncommon::inhibit_menu_check(\$href_path); + if ($form) { + my $href = 'javascript:'.$form.".action='".$href_path."';".$form.'.submit();'; + $output.=qq{$dir/}; + } else { + $output.=qq{$dir/}; + } + } } else { - foreach my $dir (split('/',$uri)) { + foreach my $dir (split('/',$uri)) { if (! $dir) { next; } - $output.=$dir.'/'; - } + $output.=$dir.'/'; + } } if ($uri !~ m|/$|) { $output=~s|/$||; } - return $output.''.($noformat?'':'
'); + $output.=''; + + return $output; } # --------------------- A function that generates a window for the spellchecker @@ -1143,6 +1195,7 @@ sub spellheader { my $nothing=&javascript_nothing(); return (< +// +// ]]> ENDCHECK } @@ -1186,11 +1240,18 @@ ENDLINK } sub htmlareaheaders { - return if (&htmlareablocked()); - return if (!&htmlareabrowser()); - return (< -ENDHEADERS + +ENDEDITOR + } + $s.=(< + +ENDJQUERY + return $s; } # ----------------------------------------------------------------- Preferences @@ -1226,20 +1287,105 @@ sub htmlareaselectactive { my @fields=@_; unless (&htmlareabrowser()) { return ''; } if (&htmlareablocked()) { return '
'.&enablelink(@fields); } - my $output='
". + $(document).ready(function() { + if (!($("#'.$field.'").hasClass("LC_richAlwaysOn"))) { + if (!($("#'.$field.'").hasClass("LC_richAlwaysOff"))) { + if (!($("#'.$field.'").hasClass("LC_richDetectHtml"))) { + if (!($("#'.$field.'").hasClass("LC_richDefaultOn"))) { + if (!($("#'.$field.'").hasClass("LC_richDefaultOff"))) { + var oFCKeditor = new FCKeditor("'.$field.'"); + oFCKeditor.Config["CustomConfigurationsPath"] = + "/fckeditor/loncapaconfig.js"; + oFCKeditor.ReplaceTextarea(); + oFCKeditor.Config["AutoDetectLanguage"] = false; + oFCKeditor.Config["DefaultLanguage"] = "'.$lang.'"; + } + } + } + } + } + }); +}'; + } + $output.="\nwindow.status='Activated Editfields';\n" + .'// ]]>'."\n" + .'
'. &disablelink(@fields); return $output; } @@ -1265,22 +1411,19 @@ sub htmlareabrowser { =item breadcrumbs Compiles the previously registered breadcrumbs into an series of links. -FAQ and BUG links will be placed on the left side of the table if they -are defined for the last registered breadcrumb. Additionally supports a 'component', which will be displayed on the -right side of the table (without a link). +right side of the breadcrumbs enclosing div (without a link). A link to help for the component will be included if one is specified. All inputs can be undef without problems. -Inputs: $component (the large text on the right side of the table), +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. =item clear_breadcrumbs @@ -1304,24 +1447,24 @@ returns: nothing ############################################################ { my @Crumbs; + my %tools = (); sub breadcrumbs { - my ($component,$component_help,$menulink,$helplink,$css_class,$no_mt) = @_; - # - $css_class ||= 'LC_breadcrumbs'; - my $Str = "\n".''; - # - if (defined($component)) { - $Str .= ''; + if ($faq ne '' || $component_help ne '' || $bug ne '') { + $icons .= &Apache::loncommon::help_open_menu($component, + $component_help, + $faq,$bug); } - $Str .= '
'; + 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 = ' ▶ '; + 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 (!defined($menulink)) { $menulink=1; } if ($menulink) { my $description = 'Menu'; my $no_mt_descr = 0; @@ -1331,44 +1474,46 @@ returns: nothing $env{'course.'.$env{'request.course.id'}.'.description'}; $no_mt_descr = 1; } - unshift(@Crumbs,{ - href =>'/adm/menu', - title =>'Go to main menu', - target =>'_top', - text =>$description, - no_mt =>$no_mt_descr, - }); + $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($crumbsymbol, + my $links = join "", map { - $faq = $_->{'faq'} if (exists($_->{'faq'})); - $bug = $_->{'bug'} if (exists($_->{'bug'})); + $faq = $_->{'faq'} if (exists($_->{'faq'})); + $bug = $_->{'bug'} if (exists($_->{'bug'})); $help = $_->{'help'} if (exists($_->{'help'})); - my $result = '{'target'}) && $_->{'target'} ne '') { - $result .= 'target="'.$_->{'target'}.'" '; - } - if ($_->{'no_mt'}) { - $result .='title="'.$_->{'title'}.'">'. - $_->{'text'}.''; - } else { - $result .='title="'.&mt($_->{'title'}).'">'. - &mt($_->{'text'}).''; - } - $result; - } @Crumbs - ); - $links .= $crumbsymbol if ($links ne ''); - if ($last->{'no_mt'}) { - $links .= ''.$last->{'text'}.''; - } else { - $links .= ''.&mt($last->{'text'}).''; - } - # + + my $result = htmltag( 'a', + $_->{no_mt} ? + $_->{text} : mt($_->{text}), + { + href => $_->{href}, + title => $_->{no_mt} ? + $_->{title} : mt($_->{title}), + target => $_->{target}, + }); + $result = htmltag( 'li', "$result $crumbsymbol"); + } @Crumbs; + + #should the last Element be translated? + $links .= htmltag( 'li', + htmltag( 'b', + $last->{'no_mt'} ? + $last->{'text'} : mt($last->{'text'}) )); + my $icons = ''; - $faq = $last->{'faq'} if (exists($last->{'faq'})); - $bug = $last->{'bug'} if (exists($last->{'bug'})); + $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 '') { @@ -1377,42 +1522,100 @@ returns: nothing # 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); - } - # - $Str .= $links.''; - if ($no_mt) { - $Str .= $component; - } else { - $Str .= &mt($component); - } - if ($icons ne '') { - $Str .= ' '.$icons; - } - $Str .= '
'."\n"; # + + + 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; + } + + #SD START (work in progress!) + add_tools(\$links); + #SD END + $links = htmltag('div', $links, + { id => "LC_breadcrumbs" }) unless ($CourseBreadcrumbs) ; + add_advtools(\$links); + # Return the @Crumbs stack to what we started with push(@Crumbs,$last); shift(@Crumbs); - # - return $Str; + # Return the breadcrumb's line + return "$links"; } sub clear_breadcrumbs { undef(@Crumbs); + undef(%tools); } sub add_breadcrumb { - push (@Crumbs,@_); + push(@Crumbs,@_); + } + + + #SD START (work in progress!) + sub add_breadcrumb_tool { + my ($category, $html) = @_; + return unless $html; + if (!defined(%tools)) { + my %tools = ( A => [], B => [], C => []); + } + push @{$tools{$category}}, $html; + } + + sub clear_breadcrumb_tools { + undef(%tools); + } + + sub add_tools { + my ($links) = @_; + return unless defined %tools; + my $html = '
    '; + for my $category ('A','B') { + $html .= '
  • ' + . '
      "; + for my $item (@{$tools{$category}}){ + #SD ugly! I'll fix that later on + $item =~ s/align="(right|left)"//; + $item =~ s///; + $html .= "
    • $item
      • "; + } + $html .= '
    • '; + if ($category eq 'A') { $html .= "
  • $$links
    • "; } + } + $$links = $html.'
'; + } + + sub add_advtools { + my ($links) = @_; + return unless (defined $tools{'C'}) and (scalar (@{$tools{'C'}}) > 0); + my $html = start_funclist(); + for my $item (@{$tools{'C'}}){ + next unless $item; + $item =~ s/align="(right|left)"//; + $html .= add_item_funclist($item); + } + $html .= end_funclist(); + $html = Apache::loncommon::head_subbox($html); + $$links .= $html; } + #SD END } # End of scope for @Crumbs @@ -1472,6 +1675,9 @@ returns: nothing # 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)) { @@ -1479,6 +1685,7 @@ sub start_pick_box { } else { $css_class= 'class="LC_pick_box"'; } + unshift(@row_count,0); my $output = <<"END"; END @@ -1486,6 +1693,7 @@ END } sub end_pick_box { + shift(@row_count); my $output = <<"END";
END @@ -1500,22 +1708,23 @@ END } sub row_title { - my ($title,$css_title_class,$css_value_class) = @_; + 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'; - $css_value_class = 'class="'.$css_value_class.'"'; if ($title ne '') { $title .= ':'; } my $output = <<"ENDONE"; - + $title - + ENDONE return $output; } @@ -1537,14 +1746,21 @@ ENDTWO return $output; } +} # End: row_count block for pick_box + + 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|; foreach my $role (@$roles) { my $plrole; if ($role eq 'ow') { @@ -1563,7 +1779,7 @@ sub role_select_row { $plrole = &mt('Custom Role'); } } else { - $plrole=&Apache::lonnet::plaintext($role); + $plrole=&Apache::lonnet::plaintext($role,$crstype); } if (($role ne 'cr') || (!$show_separate_custom)) { $output .= ' '; @@ -1578,17 +1794,18 @@ sub role_select_row { sub course_select_row { my ($title,$formname,$totcodes,$codetitles,$idlist,$idlist_titles, - $css_class) = @_; + $css_class,$crstype) = @_; my $output = &row_title($title,$css_class); - $output .= &course_selection($formname,$totcodes,$codetitles,$idlist,$idlist_titles); + $output .= &course_selection($formname,$totcodes,$codetitles,$idlist,$idlist_titles,$crstype); $output .= &row_closure(); return $output; } sub course_selection { - my ($formname,$totcodes,$codetitles,$idlist,$idlist_titles) = @_; + 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):'); + } + my $courseform=''.&Apache::loncommon::selectcourse_link - ($formname,'pickcourse','pickdomain','coursedesc','',1).''; - $output .= ''.&mt('All courses').'
'; + ($formname,'pickcourse','pickdomain','coursedesc','',1,$crstype).''; + $output .= ''.$allcrs.'
'; if ($totcodes > 0) { my $numtitles = @$codetitles; if ($numtitles > 0) { @@ -1660,7 +1888,7 @@ sub course_selection { $output .= '
'; } } - $output .= ''.&mt('Pick specific course(s):').' '.$courseform.'  selected.
'."\n"; + $output .= ''.$pickspec.' '.$courseform.'  selected.
'."\n"; return $output; } @@ -1671,7 +1899,7 @@ sub status_select_row { $output = &row_title($title,$css_class,'LC_pick_box_select'); } $output .= qq| - \n|; foreach my $status_type (sort(keys(%{$types}))) { $output .= ' '; } @@ -1748,18 +1976,21 @@ sub course_custom_roles { # 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 -# +# 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 ($imgnum,$title) = @_; - return ' -
- '.&mt('Step [_1]',$imgnum). - '  - '.$title.' -
-'; + my ($num,$title) = @_; + my $number = ''; + if ($num ne '') { + $number = ''.$num.''; + } + return '
'.$number.$title.'
'; } ############################################## @@ -1894,7 +2125,7 @@ sub set_form_elements { $values{$name}[$i] =~ s/([\r\n\f]+)/\\n/g; $values{$name}[$i] =~ s/"/\\"/g; } - if ($$elements{$name} eq 'text') { + if (($$elements{$name} eq 'text') || ($$elements{$name} eq 'hidden')) { my $numvalues = @{$values{$name}}; if ($numvalues > 1) { my $valuestring = join('","',@{$values{$name}}); @@ -1929,6 +2160,8 @@ sub set_form_elements { $output .= qq| if (courseForm.elements['$name'].value == "$value") { courseForm.elements['$name'].checked = true; + } else { + courseForm.elements['$name'].checked = false; }|; } } @@ -1970,6 +2203,7 @@ sub set_form_elements { } } $output .= " + return; }\n"; return $output; } @@ -2012,6 +2246,271 @@ END } +# 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