--- loncom/interface/loncommon.pm 2004/08/26 22:41:33 1.209 +++ loncom/interface/loncommon.pm 2004/11/08 22:50:37 1.227 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.209 2004/08/26 22:41:33 albertel Exp $ +# $Id: loncommon.pm,v 1.227 2004/11/08 22:50:37 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -59,7 +59,6 @@ use Apache::lonnet(); use GDBM_File; use POSIX qw(strftime mktime); use Apache::Constants qw(:common :http :methods); -use Apache::lonmsg(); use Apache::lonmenu(); use Apache::lonlocal; use HTML::Entities; @@ -254,6 +253,7 @@ sub browser_and_searcher_javascript { if (!defined($mode)) { $mode='edit'; } my $resurl=&lastresurl(); return < END } @@ -483,7 +492,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) { @@ -743,8 +757,9 @@ sub help_open_bug { # Add the graphic 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; @@ -787,8 +802,9 @@ sub help_open_faq { # Add the graphic 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; @@ -1725,21 +1741,26 @@ sub get_related_words { =over 4 -=item * plainname($uname,$udom) +=item * plainname($uname,$udom,$first) Takes a users logon name and returns it as a string in -"first middle last generation" form +"first middle last generation" form +if $first is set to 'lastname' then it returns it as +'lastname generation, firstname middlename' if their is a lastname =cut ############################################################### sub plainname { - my ($uname,$udom)=@_; + my ($uname,$udom,$first)=@_; my %names=&Apache::lonnet::get('environment', ['firstname','middlename','lastname','generation'], $udom,$uname); - my $name=$names{'firstname'}.' '.$names{'middlename'}.' '. - $names{'lastname'}.' '.$names{'generation'}; + my $name=&Apache::lonnet::format_name($names{'firstname'}, + $names{'middlename'}, + $names{'lastname'}, + $names{'generation'},$first); + $name=~s/^\s+//; $name=~s/\s+$//; $name=~s/\s+/ /g; if ($name !~ /\S/) { $name=$uname.'@'.$udom; } @@ -1765,8 +1786,19 @@ if the user does not sub nickname { my ($uname,$udom)=@_; - my %names=&Apache::lonnet::get('environment', - ['nickname','firstname','middlename','lastname','generation'],$udom,$uname); + my %names; + if ($uname eq $ENV{'user.name'} && + $udom eq $ENV{'user.domain'}) { + %names=('nickname' => $ENV{'environment.nickname'} , + 'firstname' => $ENV{'environment.firstname'} , + 'middlename' => $ENV{'environment.middlename'}, + 'lastname' => $ENV{'environment.lastname'} , + 'generation' => $ENV{'environment.generation'}); + } else { + %names=&Apache::lonnet::get('environment', + ['nickname','firstname','middlename', + 'lastname','generation'],$udom,$uname); + } my $name=$names{'nickname'}; if ($name) { $name='"'.$name.'"'; @@ -1792,11 +1824,13 @@ Gets a users screenname and returns it a sub screenname { my ($uname,$udom)=@_; - my %names= - &Apache::lonnet::get('environment',['screenname'],$udom,$uname); + if ($uname eq $ENV{'user.name'} && + $udom eq $ENV{'user.domain'}) {return $ENV{'environment.screenname'};} + my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname); return $names{'screenname'}; } + # ------------------------------------------------------------- Message Wrapper sub messagewrapper { @@ -2331,7 +2365,7 @@ sub maketime { my %th=@_; return POSIX::mktime( ($th{'seconds'},$th{'minutes'},$th{'hours'}, - $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,$th{'dlsav'})); + $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1)); } ######################################### @@ -2402,10 +2436,8 @@ sub domainlogo { my $domain = &determinedomain(shift); # See if there is a logo if (-e '/home/httpd/html/adm/lonDomLogos/'.$domain.'.gif') { - my $lonhttpdPort=$Apache::lonnet::perlvar{'lonhttpdPort'}; - if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; } - return ''.$domain.''; + my $logo=&lonhttpdurl("/adm/lonDomLogos/$domain.gif"); + return ''.$domain.''; } elsif(exists($Apache::lonnet::domaindescription{$domain})) { return $Apache::lonnet::domaindescription{$domain}; } else { @@ -2491,7 +2523,7 @@ other decorations will be returned. =cut sub bodytag { - my ($title,$function,$addentries,$bodyonly,$domain,$forcereg)=@_; + my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,$customtitle)=@_; $title=&mt($title); $function = &get_users_function() if (!$function); my $img=&designparm($function.'.img',$domain); @@ -2537,6 +2569,7 @@ END return $bodytag; } elsif ($ENV{'browser.interface'} eq 'textual') { # Accessibility + return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web', $forcereg). '

LON-CAPA: '.$title.'

'; @@ -2558,15 +2591,23 @@ END

ENDROLE + my $titleinfo = ''.$title.''; + if ($customtitle) { + $titleinfo = $customtitle; + } return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web', $forcereg). - ''.$roleinfo.'
'.$title. -'
'; + ''.$roleinfo.'
'.$titleinfo.'
'; } # # Top frame rendering, Remote is up # + my $titleinfo = ' '.$title.''; + if ($customtitle) { + $titleinfo = $customtitle; + } return(< @@ -2576,7 +2617,7 @@ $upperleft - $title +$titleinfo $ENV{'environment.firstname'} @@ -2732,12 +2773,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 @@ -2749,12 +2790,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 { @@ -3255,7 +3297,18 @@ sub DrawBarGraph { if (! @Values || ref($Values[0]) ne 'ARRAY') { return ''; } + # + my @Labels; + if (defined($labels)) { + @Labels = @$labels; + } else { + for (my $i=0;$i<@{$Values[0]};$i++) { + push (@Labels,$i+1); + } + } + # my $NumBars = scalar(@{$Values[0]}); + if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); } my %ValuesHash; my $NumSets=1; foreach my $array (@Values) { @@ -3265,7 +3318,15 @@ sub DrawBarGraph { } # my ($height,$width,$xskip,$bar_width) = (200,120,1,15); - if ($NumBars < 10) { + if ($NumBars < 3) { + $width = 120+$NumBars*32; + $xskip = 1; + $bar_width = 30; + } elsif ($NumBars < 5) { + $width = 120+$NumBars*20; + $xskip = 1; + $bar_width = 20; + } elsif ($NumBars < 10) { $width = 120+$NumBars*15; $xskip = 1; $bar_width = 15; @@ -3283,15 +3344,6 @@ sub DrawBarGraph { $bar_width = 4; } # - my @Labels; - if (defined($labels)) { - @Labels = @$labels; - } else { - for (my $i=0;$i<@{$Values[0]};$i++) { - push (@Labels,$i+1); - } - } - # $Max = 1 if ($Max < 1); if ( int($Max) < $Max ) { $Max++; @@ -3548,8 +3600,8 @@ Inputs: sub chartlink { my ($linktext, $sname, $sdomain) = @_; my $link = ''.$linktext.''; } @@ -3686,6 +3738,45 @@ sub icon { return $iconname; } +sub lonhttpdurl { + my ($url)=@_; + my $lonhttpd_port=$Apache::lonnet::perlvar{'lonhttpdPort'}; + if (!defined($lonhttpd_port)) { $lonhttpd_port='8080'; } + return 'http://'.$ENV{'SERVER_NAME'}.':'.$lonhttpd_port.$url; +} + +sub connection_aborted { + my ($r)=@_; + $r->print(" ");$r->rflush(); + my $c = $r->connection; + return $c->aborted(); +} + +# Escapes strings that may have embedded 's that will be put into +# strings as 'strings'. +sub escape_single { + my ($input) = @_; + $input =~ s/\\/\\\\/g; # Escape the \'s..(must be first)> + $input =~ s/\'/\\\'/g; # Esacpe the 's.... + return $input; +} + +# Same as escape_single, but escape's "'s This +# can be used for "strings" +sub escape_double { + my ($input) = @_; + $input =~ s/\\/\\\\/g; # Escape the /'s..(must be first)> + $input =~ s/\"/\\\"/g; # Esacpe the "s.... + return $input; +} + +# Escapes the last element of a full URL. +sub escape_url { + my ($url) = @_; + my @urlslices = split(/\//, $url); + my $lastitem = &Apache::lonnet::escape(pop(@urlslices)); + return join('/',@urlslices).'/'.$lastitem; +} =pod =back