--- loncom/interface/loncommon.pm 2004/03/19 03:47:09 1.187 +++ loncom/interface/loncommon.pm 2004/10/21 11:17:00 1.222 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.187 2004/03/19 03:47:09 albertel Exp $ +# $Id: loncommon.pm,v 1.222 2004/10/21 11:17:00 foxr Exp $ # # Copyright Michigan State University Board of Trustees # @@ -74,6 +74,7 @@ my $readit; my %language; my %supported_language; my %cprtag; +my %scprtag; my %fe; my %fd; my %category_extensions; @@ -131,6 +132,20 @@ BEGIN { close($fh); } } +# ------------------------------------------------------------------ source copyrights + { + my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}. + '/source_copyright.tab'; + if ( open (my $fh,"<$sourcecopyrightfile") ) { + while (<$fh>) { + next if /^\#/; + chomp; + my ($key,$val)=(split(/\s+/,$_,2)); + $scprtag{$key}=$val; + } + close($fh); + } + } # -------------------------------------------------------------- domain designs @@ -235,8 +250,11 @@ of the element the selection from the se =cut sub browser_and_searcher_javascript { + my ($mode)=@_; + if (!defined($mode)) { $mode='edit'; } my $resurl=&lastresurl(); return < END } @@ -466,7 +493,7 @@ sub linked_select_forms { my $first = "document.$formname.$firstselectname"; # output the javascript to do the changing my $result = ''; - $result.=" + (Help Menu) +ENDTEMPLATE + if ($component_help) { + if (!$text) { + $template=&help_open_topic($component_help,undef,$stayOnPage, + $width,$height).' '.$template; + } else { + my $help_text; + $help_text=&Apache::lonnet::unescape($topic); + $template='
'. + &help_open_topic($component_help,$help_text,$stayOnPage, + $width,$height).''.$template. + '
'; + } + } + if ($text ne '') { $template.='' }; + return $template; +} + sub help_open_bug { my ($topic, $text, $stayOnPage, $width, $height) = @_; unless ($ENV{'user.adv'}) { return ''; } @@ -658,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; @@ -702,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; @@ -727,7 +828,7 @@ format. sub csv_translate { my $text = shift; $text =~ s/\"/\"\"/g; - $text =~ s/\n//g; + $text =~ s/\n/ /g; return $text; } @@ -778,7 +879,7 @@ sub define_excel_formats { $format->{'h2'} = $workbook->add_format(bold=>1, size=>16); $format->{'h3'} = $workbook->add_format(bold=>1, size=>14); $format->{'date'} = $workbook->add_format(num_format=> - 'mmm d yyyy hh:mm AM/PM'); + 'mm/dd/yyyy hh:mm:ss'); return $format; } @@ -907,21 +1008,27 @@ sub domain_select { } &get_domains; if ($multiple) { $domains{''}=&mt('Any domain'); - return &multiple_select_form($name,$value,%domains); + return &multiple_select_form($name,$value,4,%domains); } else { return &select_form($name,$value,%domains); } } sub multiple_select_form { - my ($name,$value,%hash)=@_; + my ($name,$value,$size,%hash)=@_; my %selected = map { $_ => 1 } ref($value)?@{$value}:($value); my $output=''; - my $size =(scalar keys %hash<4?scalar keys %hash:4); + if (! defined($size)) { + $size = 4; + if (scalar(keys(%hash))<4) { + $size = scalar(keys(%hash)); + } + } $output.="\n\n"; return $output; @@ -1651,6 +1758,7 @@ sub plainname { $names{'lastname'}.' '.$names{'generation'}; $name=~s/\s+$//; $name=~s/\s+/ /g; + if ($name !~ /\S/) { $name=$uname.'@'.$udom; } return $name; } @@ -1673,8 +1781,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.'"'; @@ -1700,17 +1819,21 @@ 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 { - my ($link,$un,$do)=@_; + my ($link,$username,$domain)=@_; return -"$link"; + ''.$link.''; } # --------------------------------------------------------------- Notes Wrapper @@ -1723,8 +1846,8 @@ sub noteswrapper { sub aboutmewrapper { my ($link,$username,$domain,$target)=@_; - return "$link"; + return ''.$link.''; } # ------------------------------------------------------------ Syllabus Wrapper @@ -1735,9 +1858,28 @@ sub syllabuswrapper { if ($fontcolor) { $linktext=''.$linktext.''; } - return "$linktext"; + return qq{$linktext}; } +sub track_student_link { + my ($linktext,$sname,$sdom,$target) = @_; + my $link ="/adm/trackstudent"; + my $title = 'View recent activity'; + if (defined($sname) && $sname !~ /^\s*$/ && + defined($sdom) && $sdom !~ /^\s*$/) { + $link .= "?selected_student=$sname:$sdom"; + $title .= ' of this student'; + } + if (defined($target) && $target !~ /^\s*$/) { + $target = qq{target="$target"}; + } else { + $target = ''; + } + return qq{$linktext}; +} + + + =pod =back @@ -1807,6 +1949,30 @@ sub copyrightdescription { =pod +=item * source_copyrightids() + +returns list of all source copyrights + +=cut + +sub source_copyrightids { + return sort(keys(%scprtag)); +} + +=pod + +=item * source_copyrightdescription() + +returns description of a specified source copyright id + +=cut + +sub source_copyrightdescription { + return &mt($scprtag{shift(@_)}); +} + +=pod + =item * filecategories() returns list of all file categories @@ -1845,7 +2011,7 @@ sub fileembstyle { sub filecategoryselect { my ($name,$value)=@_; - return &select_form($name,$value, + return &select_form($value,$name, '' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))); } @@ -1859,7 +2025,9 @@ returns description for a specified file =cut sub filedescription { - return &mt($fd{lc(shift(@_))}); + my $file_description = $fd{lc(shift())}; + $file_description =~ s:([\[\]]):~$1:g; + return &mt($file_description); } =pod @@ -1873,7 +2041,9 @@ extra formatting sub filedescriptionex { my $ex=shift; - return '.'.$ex.' '.&mt($fd{lc($ex)}); + my $file_description = $fd{lc($ex)}; + $file_description =~ s:([\[\]]):~$1:g; + return '.'.$ex.' '.&mt($file_description); } # End of .tab access @@ -2190,7 +2360,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)); } ######################################### @@ -2261,10 +2431,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 { @@ -2401,10 +2569,26 @@ END '

LON-CAPA: '.$title.'

'; } elsif ($ENV{'environment.remote'} eq 'off') { # No Remote + my $roleinfo=(< +

+ + $ENV{'environment.firstname'} + $ENV{'environment.middlename'} + $ENV{'environment.lastname'} + $ENV{'environment.generation'} +   +
+$role  +
+$realm  +

+ +ENDROLE return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web', $forcereg). - '
'.$title. -'
'; + ''.$roleinfo.'
'.$title. +'
'; } # @@ -2434,7 +2618,7 @@ $upperleft $realm  -
+
ENDBODY } @@ -2575,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 @@ -2592,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 { @@ -3108,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; @@ -3391,8 +3580,8 @@ Inputs: sub chartlink { my ($linktext, $sname, $sdomain) = @_; my $link = ''.$linktext.''; } @@ -3529,6 +3718,85 @@ 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'. +# 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 escape_single { + 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; +} +# Same as escape_single, but escape's "'s This +# can be used for "strings" +# +# Parameters: +# input - The string to escape. +# Returns: +# The escaped string (" replaced by \" and \ replaced by \\). +# +sub escape_double { + 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; +} +# +# Escapes the last element of a full URL. +# +# Parameters: +# url - The url to escape. +# Returns: +# The url with the last element escaped via lonnet::escape. +# +sub escape_url { + my ($url) = @_; + my @urlslices = split(/\//, $url); + + my $lastitem = $urlslices[scalar(@urlslices) -1]; + $lastitem = &Apache::lonnet::escape($lastitem); + + my $escaped_url; + for (my $i = 0; $i < scalar(@urlslices) -1; $i++) { + $escaped_url .= $urlslices[$i] .'/'; + } + $escaped_url .= $lastitem ; + + return $escaped_url; +} =pod =back