--- loncom/interface/loncommon.pm 2004/08/26 22:41:33 1.209
+++ loncom/interface/loncommon.pm 2004/11/13 21:06:27 1.231
@@ -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.231 2004/11/13 21:06:27 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;
+// <!-- BEGIN LON-CAPA Internal
var editbrowser = null;
function openbrowser(formname,elementname,only,omit,titleelement) {
var url = '$resurl/?';
@@ -265,16 +265,22 @@ sub browser_and_searcher_javascript {
url += 'form=' + formname + '&';
if (only != null) {
url += 'only=' + only + '&';
- }
+ } else {
+ url += 'only=&';
+ }
if (omit != null) {
url += 'omit=' + omit + '&';
- }
+ } else {
+ url += 'omit=&';
+ }
if (titleelement != null) {
url += 'titleelement=' + titleelement + '&';
- }
+ } else {
+ url += 'titleelement=&';
+ }
url += 'element=' + elementname + '';
var title = 'Browser';
- var options = 'scrollbars=1,resizable=1,menubar=0';
+ var options = 'scrollbars=1,resizable=1,menubar=1,location=1';
options += ',width=700,height=600';
editbrowser = open(url,title,options,'1');
editbrowser.focus();
@@ -290,7 +296,9 @@ sub browser_and_searcher_javascript {
url += 'form=' + formname + '&';
if (titleelement != null) {
url += 'titleelement=' + titleelement + '&';
- }
+ } else {
+ url += 'titleelement=&';
+ }
url += 'element=' + elementname + '';
var title = 'Search';
var options = 'scrollbars=1,resizable=1,menubar=0';
@@ -298,6 +306,7 @@ sub browser_and_searcher_javascript {
editsearcher = open(url,title,options,'1');
editsearcher.focus();
}
+// END LON-CAPA Internal -->
END
}
@@ -366,9 +375,10 @@ sub selectstudent_link {
}
sub coursebrowser_javascript {
- my ($domainfilter)=@_;
+ my ($domainfilter,$roleelement)=@_;
return (<<ENDSTDBRW);
<script type="text/javascript" language="Javascript" >
+ var extra_element = "$roleelement"
var stdeditbrowser;
function opencrsbrowser(formname,uname,udom,desc) {
var url = '/adm/pickcourse?';
@@ -387,6 +397,9 @@ sub coursebrowser_javascript {
url += 'form=' + formname + '&cnumelement='+uname+
'&cdomelement='+udom+
'&cnameelement='+desc;
+ if (extra_element != '') {
+ url += '&roleelement=$roleelement';
+ }
var title = 'Course_Browser';
var options = 'scrollbars=1,resizable=1,menubar=0';
options += ',width=700,height=600';
@@ -483,7 +496,7 @@ sub linked_select_forms {
my $first = "document.$formname.$firstselectname";
# output the javascript to do the changing
my $result = '';
- $result.="<script>\n";
+ $result.="<script type=\"text/javascript\">\n";
$result.="var select2data = new Object();\n";
$" = '","';
my $debug = '';
@@ -611,8 +624,9 @@ sub help_open_topic {
# Add the graphic
my $title = &mt('Online Help');
+ my $helpicon=&lonhttpdurl("/adm/help/gif/smallHelp.gif");
$template .= <<"ENDTEMPLATE";
- <a href="$link" title="$title"><image src="/adm/help/gif/smallHelp.gif" border="0" alt="(Help: $topic)" /></a>
+ <a href="$link" title="$title"><img src="$helpicon" border="0" alt="(Help: $topic)" /></a>
ENDTEMPLATE
if ($text ne '') { $template.='</td></tr></table>' };
return $template;
@@ -652,6 +666,7 @@ sub help_open_menu {
my $link='';
my $title = &mt('Get help');
my $origurl = $ENV{'REQUEST_URI'};
+ $origurl=~s|^/~|/priv/|;
my $timestamp = time;
foreach (\$color,\$function,\$topic,\$component_help,\$faq,\$bug,\$origurl) {
$$_ = &Apache::lonnet::escape($$_);
@@ -667,11 +682,13 @@ sub help_open_menu {
my $template;
if ($text ne "") {
$template .=
- "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
- "<td bgcolor='#448844'><a href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";
+ "<table bgcolor='#773311' cellspacing='1' cellpadding='1' border='0'><tr>".
+ "<td bgcolor='#886622'><a href=\"$link\"><font color='#FFFFFF' size='2'>$text</font></a>";
}
+ my $helpicon=&lonhttpdurl("/adm/lonIcons/helpgateway.gif");
$template .= <<"ENDTEMPLATE";
- <script>
+ <script type="text/javascript">
+//<!-- BEGIN LON-CAPA Internal
function helpMenu(caller) {
if (caller == 'open') {
newWindow = window.open("","helpmenu","HEIGHT=$height,WIDTH=$width,resize=yes,scrollbars=yes" )
@@ -687,8 +704,9 @@ function helpMenu(caller) {
caller.focus()
}
}
+// END LON-CAPA Internal -->
</script>
- <a href="$link" title="$title"><image src="/adm/lonIcons/helpgateway.gif" border="0" alt="(Help Menu)" /></a>
+ <a href="$link" title="$title"><img src="$helpicon" border="0" alt="(Help Menu)" /></a>
ENDTEMPLATE
if ($component_help) {
if (!$text) {
@@ -743,8 +761,9 @@ sub help_open_bug {
# Add the graphic
my $title = &mt('Report a Bug');
+ my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
$template .= <<"ENDTEMPLATE";
- <a href="$link" title="$title"><image src="/adm/lonMisc/smallBug.gif" border="0" alt="(Bug: $topic)" /></a>
+ <a href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
ENDTEMPLATE
if ($text ne '') { $template.='</td></tr></table>' };
return $template;
@@ -787,8 +806,9 @@ sub help_open_faq {
# Add the graphic
my $title = &mt('View the FAQ');
+ my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
$template .= <<"ENDTEMPLATE";
- <a href="$link" title="$title"><image src="/adm/lonMisc/smallFAQ.gif" border="0" alt="(FAQ: $topic)" /></a>
+ <a href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
ENDTEMPLATE
if ($text ne '') { $template.='</td></tr></table>' };
return $template;
@@ -1725,21 +1745,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 +1790,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 +1828,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 +2369,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 +2440,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 '<img src="http://'.$ENV{'HTTP_HOST'}.':'.$lonhttpdPort.
- '/adm/lonDomLogos/'.$domain.'.gif" alt="'.$domain.'" />';
+ my $logo=&lonhttpdurl("/adm/lonDomLogos/$domain.gif");
+ return '<img src="'.$logo.'" alt="'.$domain.'" />';
} elsif(exists($Apache::lonnet::domaindescription{$domain})) {
return $Apache::lonnet::domaindescription{$domain};
} else {
@@ -2491,7 +2527,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);
@@ -2524,7 +2560,7 @@ sub bodytag {
if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; }
# construct main body tag
my $bodytag = <<END;
-<style>
+<style type="text/css">
h1, h2, h3, th { font-family: Arial, Helvetica, sans-serif }
a:focus { color: red; background: yellow }
</style>
@@ -2537,6 +2573,7 @@ END
return $bodytag;
} elsif ($ENV{'browser.interface'} eq 'textual') {
# Accessibility
+
return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web',
$forcereg).
'<h1>LON-CAPA: '.$title.'</h1>';
@@ -2544,7 +2581,6 @@ END
# No Remote
my $roleinfo=(<<ENDROLE);
<td bgcolor="$tabbg" align="right">
-<p>
<font size="2" face="Arial, Helvetica, sans-serif">
$ENV{'environment.firstname'}
$ENV{'environment.middlename'}
@@ -2555,18 +2591,42 @@ END
<font size="2" face="Arial, Helvetica, sans-serif">$role</font>
<br />
<font size="2" face="Arial, Helvetica, sans-serif">$realm</font>
-</p>
</td>
ENDROLE
+ my $titleinfo = '<font face="Arial, Helvetica, sans-serif" size="+3" color="'.
+ $font.'"><b>'.$title.'</b></font>';
+ if ($customtitle) {
+ $titleinfo = $customtitle;
+ }
+ if ($ENV{'request.state'} eq 'construct') {
+ my ($uname,$thisdisfn)=
+ ($ENV{'request.filename'} =~ m|^/home/([^/]+)/public_html/(.*)|);
+ my $formaction='/priv/'.$uname.'/'.$thisdisfn;
+ $formaction=~s/\/+/\//g;
+ $titleinfo = '<form name="dirs" method="post" action="'.$formaction
+ .'" target="_top">'
+ .&Apache::lonhtmlcommon::crumbs($uname.'/'.$thisdisfn,'_top','/priv','',-1,1)."<br />"
+ .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
+ .'</form>'
+ .&Apache::lonmenu::constspaceform();
+
+ &Apache::lonhtmlcommon::store_recent('construct',$formaction,$formaction);
+ if ($thisdisfn!~m|/$|) { $forcereg=1; }
+ }
+
+ &Apache::lonnet::logthis("hrrm");
return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web',
$forcereg).
- '<table bgcolor="'.$pgbg.'" width="100%" border="0" cellspacing="3" cellpadding="3"><tr><td rowspan="3" bgcolor="'.$tabbg.'"><font face="Arial, Helvetica, sans-serif" size="+3" color="'.$font.'"><b>'.$title.
-'</b></font></td>'.$roleinfo.'</tr></table>';
+ '<table bgcolor="'.$pgbg.'" width="100%" border="0" cellspacing="3" cellpadding="3"><tr><td rowspan="3" bgcolor="'.$tabbg.'">'.$titleinfo.'</td>'.$roleinfo.'</tr></table>';
}
#
# Top frame rendering, Remote is up
#
+ my $titleinfo = ' <font size="5" face="Arial, Helvetica, sans-serif"><b>'.$title.'</b></font>';
+ if ($customtitle) {
+ $titleinfo = $customtitle;
+ }
return(<<ENDBODY);
$bodytag
<table width="100%" cellspacing="0" border="0" cellpadding="0">
@@ -2576,7 +2636,7 @@ $upperleft</td>
</tr>
<tr>
<td rowspan="3" bgcolor="$tabbg">
- <font size="5" face="Arial, Helvetica, sans-serif"><b>$title</b></font>
+$titleinfo
<td bgcolor="$tabbg" align="right">
<font size="2" face="Arial, Helvetica, sans-serif">
$ENV{'environment.firstname'}
@@ -2732,12 +2792,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 .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
+ unless ($ENV{'request.method'} eq 'GET') { return ''; }
+ my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
+ my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
<meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
<meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
- return $output;
+ return $output;
}
=pod
@@ -2749,12 +2809,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 {
@@ -3249,13 +3310,28 @@ sub DrawBarGraph {
'#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
];
}
+ my $extra_settings = {};
+ if (ref($Values[-1]) eq 'HASH') {
+ $extra_settings = pop(@Values);
+ }
#
my $identifier = &get_cgi_id();
my $id = 'cgi.'.$identifier;
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 +3341,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 +3367,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++;
@@ -3314,6 +3389,11 @@ sub DrawBarGraph {
$ValuesHash{$id.'.bar_width'} = $bar_width;
$ValuesHash{$id.'.labels'} = join(',',@Labels);
#
+ # Deal with other parameters
+ while (my ($key,$value) = each(%$extra_settings)) {
+ $ValuesHash{$id.'.'.$key} = $value;
+ }
+ #
&Apache::lonnet::appenv(%ValuesHash);
return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
}
@@ -3548,8 +3628,8 @@ Inputs:
sub chartlink {
my ($linktext, $sname, $sdomain) = @_;
my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
- '&SelectedStudent='.&Apache::lonnet::escape($sname.':'.$sdomain).
- '&chartoutputmode='.HTML::Entities::encode('html, with all links').
+ '&SelectedStudent='.&Apache::lonnet::escape($sname.':'.$sdomain).
+ '&chartoutputmode='.HTML::Entities::encode('html, with all links').
'">'.$linktext.'</a>';
}
@@ -3686,6 +3766,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