--- loncom/interface/loncommon.pm 2004/09/29 19:13:20 1.215 +++ loncom/interface/loncommon.pm 2004/10/21 09:53:44 1.221 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.215 2004/09/29 19:13:20 albertel Exp $ +# $Id: loncommon.pm,v 1.221 2004/10/21 09:53:44 foxr Exp $ # # Copyright Michigan State University Board of Trustees # @@ -254,6 +254,7 @@ sub browser_and_searcher_javascript { if (!defined($mode)) { $mode='edit'; } my $resurl=&lastresurl(); return < END } @@ -483,7 +493,7 @@ sub linked_select_forms { my $first = "document.$formname.$firstselectname"; # output the javascript to do the changing my $result = ''; - $result.=" - (Help Menu) + (Help Menu) ENDTEMPLATE if ($component_help) { if (!$text) { @@ -747,7 +759,7 @@ sub help_open_bug { my $title = &mt('Report a Bug'); my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif"); $template .= <<"ENDTEMPLATE"; - (Bug: $topic) + (Bug: $topic) ENDTEMPLATE if ($text ne '') { $template.='' }; return $template; @@ -792,7 +804,7 @@ sub help_open_faq { my $title = &mt('View the FAQ'); my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif"); $template .= <<"ENDTEMPLATE"; - (FAQ: $topic) + (FAQ: $topic) ENDTEMPLATE if ($text ne '') { $template.='' }; return $template; @@ -2747,12 +2759,12 @@ returns cache-controlling header code =cut sub cacheheader { - unless ($ENV{'request.method'} eq 'GET') { return ''; } - my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime); - my $output .=' + unless ($ENV{'request.method'} eq 'GET') { return ''; } + my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime); + my $output .=' '; - return $output; + return $output; } =pod @@ -2764,12 +2776,13 @@ specifies header code to not have cache =cut sub no_cache { - my ($r) = @_; - unless ($ENV{'request.method'} eq 'GET') { return ''; } - #my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime); - $r->no_cache(1); - $r->header_out("Pragma" => "no-cache"); - #$r->header_out("Expires" => $date); + my ($r) = @_; + if ($ENV{'REQUEST_METHOD'} ne 'GET' && + $ENV{'request.method'} ne 'GET') { return ''; } + my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time)); + $r->no_cache(1); + $r->header_out("Expires" => $date); + $r->header_out("Pragma" => "no-cache"); } sub content_type { @@ -3280,7 +3293,11 @@ sub DrawBarGraph { } # my ($height,$width,$xskip,$bar_width) = (200,120,1,15); - if ($NumBars < 10) { + if ($NumBars < 5) { + $width = 120+$NumBars*25; + $xskip = 1; + $bar_width = 25; + } elsif ($NumBars < 10) { $width = 120+$NumBars*15; $xskip = 1; $bar_width = 15; @@ -3563,8 +3580,8 @@ Inputs: sub chartlink { my ($linktext, $sname, $sdomain) = @_; my $link = ''.$linktext.''; } @@ -3715,6 +3732,31 @@ sub connection_aborted { return $c->aborted(); } +# +# Escapes strings that may have embedded 's that will be put into +# javascript strings as 'strings'. +# The assumptions are: +# There has been no effort to escape ' with \' +# Any \'s in the string are intended to be there as part of the URL +# and must also be escaped. +# Parameters: +# input - The string to escape. +# Returns: +# The escaped string (' replaced by \' and \ replaced by \\). +# +sub javascript_escape { + my ($input) = @_; + + # I imagine a regexp wizard could combine the two expressions below. + # If you do you might want to comment the result. + + $input =~ s/\\/\\\\/g; # Escape the /'s..(must be first)> + $input =~ s/\'/\\\'/g; # Esacpe the 's.... + + return $input; +} + + =pod =back