--- loncom/interface/loncommon.pm 2004/10/21 09:53:44 1.221
+++ loncom/interface/loncommon.pm 2005/03/10 00:21:48 1.255
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.221 2004/10/21 09:53:44 foxr Exp $
+# $Id: loncommon.pm,v 1.255 2005/03/10 00:21:48 matthew 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;
@@ -380,7 +379,7 @@ sub coursebrowser_javascript {
return (<<ENDSTDBRW);
<script type="text/javascript" language="Javascript" >
var stdeditbrowser;
- function opencrsbrowser(formname,uname,udom,desc) {
+ function opencrsbrowser(formname,uname,udom,desc,extra_element) {
var url = '/adm/pickcourse?';
var filter;
if (filter != null) {
@@ -397,6 +396,12 @@ sub coursebrowser_javascript {
url += 'form=' + formname + '&cnumelement='+uname+
'&cdomelement='+udom+
'&cnameelement='+desc;
+ if (extra_element !=null && extra_element != '' && formname == 'rolechoice') {
+ url += '&roleelement='+extra_element;
+ if (domainfilter == null || domainfilter == '') {
+ url += '&domainfilter='+extra_element;
+ }
+ }
var title = 'Course_Browser';
var options = 'scrollbars=1,resizable=1,menubar=0';
options += ',width=700,height=600';
@@ -408,9 +413,9 @@ ENDSTDBRW
}
sub selectcourse_link {
- my ($form,$unameele,$udomele,$desc)=@_;
+ my ($form,$unameele,$udomele,$desc,$extra_element)=@_;
return "<a href='".'javascript:opencrsbrowser("'.$form.'","'.$unameele.
- '","'.$udomele.'","'.$desc.'");'."'>".&mt('Select Course')."</a>";
+ '","'.$udomele.'","'.$desc.'","'.$extra_element.'");'."'>".&mt('Select Course')."</a>";
}
=pod
@@ -542,7 +547,7 @@ END
$result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed()\">\n";
foreach my $value (sort(keys(%$hashref))) {
$result.=" <option value=\"$value\" ";
- $result.=" selected=\"true\" " if ($value eq $firstdefault);
+ $result.=" selected=\"selected\" " if ($value eq $firstdefault);
$result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
}
$result .= "</select>\n";
@@ -552,7 +557,7 @@ END
my $seconddefault = $hashref->{$firstdefault}->{'default'};
foreach my $value (sort(keys(%select2))) {
$result.=" <option value=\"$value\" ";
- $result.=" selected=\"true\" " if ($value eq $seconddefault);
+ $result.=" selected=\"selected\" " if ($value eq $seconddefault);
$result.=">".&mt($select2{$value})."</option>\n";
}
$result .= "</select>\n";
@@ -663,6 +668,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($$_);
@@ -681,25 +687,38 @@ sub help_open_menu {
"<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 $html=&Apache::lonxml::xmlbegin();
my $helpicon=&lonhttpdurl("/adm/lonIcons/helpgateway.gif");
$template .= <<"ENDTEMPLATE";
<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" )
- caller = newWindow.document
- } else {
- caller = this.document
- }
- caller.write("<html><head><title>LON-CAPA Help Menu</title><meta http-equiv='pragma' content='no-cache'></head>")
- caller.write("<frameset rows='105,*' border='0'><frame name='bannerframe' src='$banner_link'><frame name='bodyframe' src='$details_link'></frameset>")
- caller.write("</html>")
- caller.close()
- if (caller == newWindow.document) {
- caller.focus()
+// <!-- BEGIN LON-CAPA Internal
+// <![CDATA[
+function helpMenu(target) {
+ var caller = this;
+ if (target == 'open') {
+ var newWindow = null;
+ try {
+ newWindow = window.open("/adm/rat/empty.html","helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
+ }
+ catch(error) {
+ writeHelp(caller);
+ return;
+ }
+ if (newWindow) {
+ caller = newWindow;
+ }
}
+ writeHelp(caller);
+ return;
+}
+function writeHelp(caller) {
+ caller.document.write('$html<head><title>LON-CAPA Help Menu</title><meta http-equiv="pragma" content="no-cache"></head>')
+ caller.document.write("<frameset rows='105,*' border='0'><frame name='bannerframe' src='$banner_link'><frame name='bodyframe' src='$details_link'></frameset>")
+ caller.document.write("</html>")
+ caller.document.close()
+ caller.focus()
}
+// ]]>
// END LON-CAPA Internal -->
</script>
<a href="$link" title="$title"><img src="$helpicon" border="0" alt="(Help Menu)" /></a>
@@ -878,6 +897,8 @@ sub define_excel_formats {
$format->{'h1'} = $workbook->add_format(bold=>1, size=>18);
$format->{'h2'} = $workbook->add_format(bold=>1, size=>16);
$format->{'h3'} = $workbook->add_format(bold=>1, size=>14);
+ $format->{'h4'} = $workbook->add_format(bold=>1, size=>12);
+ $format->{'i'} = $workbook->add_format(italic=>1);
$format->{'date'} = $workbook->add_format(num_format=>
'mm/dd/yyyy hh:mm:ss');
return $format;
@@ -888,6 +909,49 @@ sub define_excel_formats {
=pod
+=item &create_workbook
+
+Create an Excel worksheet. If it fails, output message on the
+request object and return undefs.
+
+Inputs: Apache request object
+
+Returns (undef) on failure,
+ Excel worksheet object, scalar with filename, and formats
+ from &Apache::loncommon::define_excel_formats on success
+
+=cut
+
+###############################################################
+###############################################################
+sub create_workbook {
+ my ($r) = @_;
+ #
+ # Create the excel spreadsheet
+ my $filename = '/prtspool/'.
+ $ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'.
+ time.'_'.rand(1000000000).'.xls';
+ my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
+ if (! defined($workbook)) {
+ $r->log_error("Error creating excel spreadsheet $filename: $!");
+ $r->print('<p>'.&mt("Unable to create new Excel file. ".
+ "This error has been logged. ".
+ "Please alert your LON-CAPA administrator").
+ '</p>');
+ return (undef);
+ }
+ #
+ $workbook->set_tempdir('/home/httpd/perl/tmp');
+ #
+ my $format = &Apache::loncommon::define_excel_formats($workbook);
+ return ($workbook,$filename,$format);
+}
+
+###############################################################
+###############################################################
+
+=pod
+
=item * change_content_javascript():
This and the next function allow you to create small sections of an
@@ -1027,7 +1091,7 @@ sub multiple_select_form {
$output.="\n<select name='$name' size='$size' multiple='1'>";
foreach (sort(keys(%hash))) {
$output.='<option value="'.$_.'" ';
- $output.='selected ' if ($selected{$_});
+ $output.='selected="selected" ' if ($selected{$_});
$output.='>'.$hash{$_}."</option>\n";
}
$output.="</select>\n";
@@ -1058,7 +1122,7 @@ sub select_form {
}
foreach (@keys) {
$selectform.="<option value=\"$_\" ".
- ($_ eq $def ? 'selected' : '').
+ ($_ eq $def ? 'selected="selected" ' : '').
">".&mt($hash{$_})."</option>\n";
}
$selectform.="</select>";
@@ -1095,7 +1159,7 @@ sub select_level_form {
my $selectform = "<select name=\"$name\" size=\"1\">\n";
for (my $i=0; $i<=18; $i++) {
$selectform.="<option value=\"$i\" ".
- ($i==$deflevel ? 'selected' : '').
+ ($i==$deflevel ? 'selected="selected" ' : '').
">".&gradeleveldescription($i)."</option>\n";
}
$selectform.="</select>";
@@ -1125,7 +1189,7 @@ sub select_dom_form {
my $selectdomain = "<select name=\"$name\" size=\"1\">\n";
foreach (@domains) {
$selectdomain.="<option value=\"$_\" ".
- ($_ eq $defdom ? 'selected' : '').
+ ($_ eq $defdom ? 'selected="selected" ' : '').
">$_</option>\n";
}
$selectdomain.="</select>";
@@ -1224,9 +1288,11 @@ Outputs:
###############################################################
###############################################################
sub decode_user_agent {
+ my ($r)=@_;
my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
+ if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
my $clientbrowser='unknown';
my $clientversion='0';
my $clientmathml='';
@@ -1741,21 +1807,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; }
@@ -2274,7 +2345,7 @@ sub get_student_view {
if (defined($moreenv)) {
%form=(%form,%{$moreenv});
}
- if ($target eq 'tex') {$form{'grade_target'} = 'tex';}
+ if (defined($target)) { $form{'grade_target'} = $target; }
$feedurl=&Apache::lonnet::clutter($feedurl);
my $userview=&Apache::lonnet::ssi_body($feedurl,%form);
$userview=~s/\<body[^\>]*\>//gi;
@@ -2314,7 +2385,7 @@ sub get_student_answers {
=item * &submlink()
-Inputs: $text $uname $udom $symb
+Inputs: $text $uname $udom $symb $target
Returns: A link to grades.pm such as to see the SUBM view of a student
@@ -2322,15 +2393,64 @@ Returns: A link to grades.pm such as to
###############################################
sub submlink {
- my ($text,$uname,$udom,$symb)=@_;
+ my ($text,$uname,$udom,$symb,$target)=@_;
if (!($uname && $udom)) {
(my $cursymb, my $courseid,$udom,$uname)=
&Apache::lonxml::whichuser($symb);
if (!$symb) { $symb=$cursymb; }
}
- if (!$symb) { $symb=&symbread(); }
- return '<a href="/adm/grades?symb='.$symb.'&student='.$uname.
- '&userdom='.$udom.'&command=submission">'.$text.'</a>';
+ if (!$symb) { $symb=&Apache::lonnet::symbread(); }
+ $symb=&Apache::lonnet::escape($symb);
+ if ($target) { $target="target=\"$target\""; }
+ return '<a href="/adm/grades?&command=submission&'.
+ 'symb='.$symb.'&student='.$uname.
+ '&userdom='.$udom.'" '.$target.'>'.$text.'</a>';
+}
+##############################################
+
+=pod
+
+=item * &pgrdlink()
+
+Inputs: $text $uname $udom $symb $target
+
+Returns: A link to grades.pm such as to see the PGRD view of a student
+
+=cut
+
+###############################################
+sub pgrdlink {
+ my $link=&submlink(@_);
+ $link=~s/(&command=submission)/$1&showgrading=yes/;
+ return $link;
+}
+##############################################
+
+=pod
+
+=item * &pprmlink()
+
+Inputs: $text $uname $udom $symb $target
+
+Returns: A link to parmset.pm such as to see the PPRM view of a
+student andn resource
+
+=cut
+
+###############################################
+sub pprmlink {
+ my ($text,$uname,$udom,$symb,$target)=@_;
+ if (!($uname && $udom)) {
+ (my $cursymb, my $courseid,$udom,$uname)=
+ &Apache::lonxml::whichuser($symb);
+ if (!$symb) { $symb=$cursymb; }
+ }
+ if (!$symb) { $symb=&Apache::lonnet::symbread(); }
+ $symb=&Apache::lonnet::escape($symb);
+ if ($target) { $target="target=\"$target\""; }
+ return '<a href="/adm/parmset?&command=set&'.
+ 'symb='.$symb.'&uname='.$uname.
+ '&udom='.$udom.'" '.$target.'>'.$text.'</a>';
}
##############################################
@@ -2518,7 +2638,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);
@@ -2551,19 +2671,27 @@ 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>
<body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link"
style="margin-top: 0px;$addstyle" $addentries>
END
+ if ($ENV{'environment.texengine'} eq 'jsMath') {
+ $bodytag.='<script type="text/javascript">
+ function NoFontMessage () {}
+ </script>'."\n".
+ '<script src="/adm/jsMath/jsMath.js"></script>'."\n";
+ }
+
my $upperleft='<img src="http://'.$ENV{'HTTP_HOST'}.':'.
$lonhttpdPort.$img.'" alt="'.$function.'" />';
if ($bodyonly) {
return $bodytag;
} elsif ($ENV{'browser.interface'} eq 'textual') {
# Accessibility
+
return $bodytag.&Apache::lonmenu::menubuttons($forcereg,'web',
$forcereg).
'<h1>LON-CAPA: '.$title.'</h1>';
@@ -2571,7 +2699,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'}
@@ -2582,18 +2709,71 @@ 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
- 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>';
+ 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;
+ unless ($customtitle) { #this is for resources; directories have customtitle, and crumbs and select recent are created in lonpubdir.pm
+ my $parentpath = '';
+ my $lastitem = '';
+ if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
+ $parentpath = $1;
+ $lastitem = $2;
+ } else {
+ $lastitem = $thisdisfn;
+ }
+ $titleinfo = &Apache::loncommon::help_open_menu('','','','',3,'Authoring').
+ '<font face="Arial, Helvetica, sans-serif"><b>Construction Space</b>:</font> '.
+ '<form name="dirs" method="post" action="'.$formaction
+ .'" target="_top"><tt><b>'
+ .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv','','+1',1)."<font size=\"+1\">$lastitem</font></b></tt><br />"
+ .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
+ .'</form>'
+ .&Apache::lonmenu::constspaceform();
+
+ }
+ $forcereg=1;
+ }
+ my $titletable = '<table bgcolor="'.$pgbg.'" width="100%" border="0" '.
+ 'cellspacing="3" cellpadding="3">'.
+ '<tr><td rowspan="3" bgcolor="'.$tabbg.'">'.
+ $titleinfo.'</td>'.$roleinfo.'</tr></table>';
+ if ($ENV{'request.state'} eq 'construct') {
+ $bodytag .= &Apache::lonmenu::menubuttons($forcereg,'web',$forcereg,$titletable);
+ } else {
+ $bodytag .= &Apache::lonmenu::menubuttons($forcereg,'web',$forcereg).
+ $titletable;
+ }
+ return $bodytag;
}
#
# Top frame rendering, Remote is up
#
+ my $titleinfo = ' <font size="5" face="Arial, Helvetica, sans-serif"><b>'.$title.'</b></font>';
+ if ($customtitle) {
+ $titleinfo = $customtitle;
+ }
+ #
+ # Extra info if you are the DC
+ my $dc_info = '';
+ if ($ENV{'user.adv'} && exists($ENV{'user.role.dc./'.
+ $ENV{'course.'.$ENV{'request.course.id'}.
+ '.domain'}.'/'})) {
+ my $cid = $ENV{'request.course.id'};
+ $dc_info.= $cid.' '.$ENV{'course.'.$cid.'.internal.coursecode'};
+ $dc_info = '('.$dc_info.')';
+ }
+ #
return(<<ENDBODY);
$bodytag
<table width="100%" cellspacing="0" border="0" cellpadding="0">
@@ -2603,7 +2783,7 @@ $upperleft</td>
</tr>
<tr>
<td rowspan="3" bgcolor="$tabbg">
- <font size="5" face="Arial, Helvetica, sans-serif"><b>$title</b></font>
+$titleinfo $dc_info
<td bgcolor="$tabbg" align="right">
<font size="2" face="Arial, Helvetica, sans-serif">
$ENV{'environment.firstname'}
@@ -2623,6 +2803,40 @@ ENDBODY
}
###############################################
+###############################################
+
+=pod
+
+=back
+
+=head1 HTTP Helpers
+
+=over 4
+
+=item * &endbodytag()
+
+Returns a uniform footer for LON-CAPA web pages.
+
+Inputs:
+
+=over 4
+
+=back
+
+Returns: A uniform footer for LON-CAPA web pages.
+
+=cut
+
+sub endbodytag {
+ my $endbodytag='</body>';
+ if ($ENV{'environment.texengine'} eq 'jsMath') {
+ $endbodytag='<script type="text/javascript">jsMath.Process()</script>'.
+ "\n".$endbodytag;
+ }
+ return $endbodytag;
+}
+
+###############################################
=pod
@@ -2651,6 +2865,61 @@ sub get_users_function {
###############################################
+=pod
+
+=item get_sections
+
+Determines all the sections for a course including
+sections with students and sections containing other roles.
+Incoming parameters: domain, course number, reference to
+section hash (keys to be section/group IDs), reference to
+array containing roles for which sections should be gathered
+(optional). If the fourth argument is undefined, sections
+are gathered for any role.
+
+Returns number of sections.
+
+=cut
+
+###############################################
+sub get_sections {
+ my ($cdom,$cnum,$sectioncount,$possible_roles) = @_;
+ if (!($cdom && $cnum)) { return 0; }
+ my $cid = $cdom.'_'.$cnum;
+ my $numsections = 0;
+
+ if (!defined($possible_roles) || (grep/^st$/,@$possible_roles)) {
+ my ($classlist) = &Apache::loncoursedata::get_classlist($cid,$cdom,$cnum);
+ my $sec_index = &Apache::loncoursedata::CL_SECTION();
+ my $status_index = &Apache::loncoursedata::CL_STATUS();
+ while (my ($student,$data) = each %$classlist) {
+ my ($section,$status) = ($data->[$sec_index],
+ $data->[$status_index]);
+ unless ($section eq '-1' || $section =~ /^\s*$/) {
+ if (!defined($$sectioncount{$section})) { $numsections++; }
+ $$sectioncount{$section}++;
+ }
+ }
+ }
+ my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
+ foreach my $user (sort(keys(%courseroles))) {
+ if ($user !~ /^(\w{2})/) { next; }
+ my ($role) = ($user =~ /^(\w{2})/);
+ if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
+ my $section;
+ if ($role eq 'cr' &&
+ $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
+ $section=$1;
+ }
+ if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
+ if (!defined($section) || $section eq '-1') { next; }
+ if (!defined($$sectioncount{$section})) { $numsections++; }
+ $$sectioncount{$section}++;
+ }
+ return $numsections;
+}
+
+
sub get_posted_cgi {
my $r=shift;
@@ -2787,6 +3056,7 @@ sub no_cache {
sub content_type {
my ($r,$type,$charset) = @_;
+ if ($ENV{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
unless ($charset) {
$charset=&Apache::lonlocal::current_encoding;
}
@@ -2924,7 +3194,12 @@ needs $ENV{'form.upfile'} and $ENV{'form
sub upfile_record_sep {
if ($ENV{'form.upfiletype'} eq 'xml') {
} else {
- return split(/\n/,$ENV{'form.upfile'});
+ my @records;
+ foreach my $line (split(/\n/,$ENV{'form.upfile'})) {
+ if ($line=~/^\s*$/) { next; }
+ push(@records,$line);
+ }
+ return @records;
}
}
@@ -3082,7 +3357,7 @@ sub csv_print_select_table {
$r->print('<option value="none"></option>');
foreach (sort({$a <=> $b} keys(%sone))) {
$r->print('<option value="'.$_.'"'.
- ($_ eq $defaultcol ? ' selected ' : '').
+ ($_ eq $defaultcol ? ' selected="selected" ' : '').
'>Column '.($_+1).'</option>');
}
$r->print('</select></td></tr>'."\n");
@@ -3126,7 +3401,7 @@ sub csv_samples_select_table {
foreach (@$d) {
my ($value,$display,$defaultcol)=@{ $_ };
$r->print('<option value="'.$value.'"'.
- ($i eq $defaultcol ? ' selected ':'').'>'.
+ ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
$display.'</option>');
}
$r->print('</select></td><td>');
@@ -3257,6 +3532,9 @@ they are plotted. If undefined, default
=item @Values: An array of array references. Each array reference holds data
to be plotted in a stacked bar chart.
+=item If the final element of @Values is a hash reference the key/value
+pairs will be added to the graph definition.
+
=back
Returns:
@@ -3277,13 +3555,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) {
@@ -3293,10 +3586,14 @@ sub DrawBarGraph {
}
#
my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
- if ($NumBars < 5) {
- $width = 120+$NumBars*25;
+ if ($NumBars < 3) {
+ $width = 120+$NumBars*32;
+ $xskip = 1;
+ $bar_width = 30;
+ } elsif ($NumBars < 5) {
+ $width = 120+$NumBars*20;
$xskip = 1;
- $bar_width = 25;
+ $bar_width = 20;
} elsif ($NumBars < 10) {
$width = 120+$NumBars*15;
$xskip = 1;
@@ -3315,15 +3612,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++;
@@ -3346,6 +3634,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" />';
}
@@ -3715,7 +4008,7 @@ sub icon {
$curfext.".gif";
}
}
- return $iconname;
+ return &lonhttpdurl($iconname);
}
sub lonhttpdurl {
@@ -3732,31 +4025,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 {
+# strings as 'strings'.
+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; # 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,-1);
+ my $lastitem = &Apache::lonnet::escape(pop(@urlslices));
+ return join('/',@urlslices).'/'.$lastitem;
+}
=pod
=back