--- loncom/interface/loncommon.pm 2004/02/20 17:13:04 1.183
+++ loncom/interface/loncommon.pm 2004/09/29 19:13:20 1.215
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.183 2004/02/20 17:13:04 matthew Exp $
+# $Id: loncommon.pm,v 1.215 2004/09/29 19:13:20 albertel 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
@@ -220,10 +235,10 @@ formname and elementname indicate the na
the element that the results of the browsing selection are to be placed in.
Specifying 'only' will restrict the browser to displaying only files
-with the given extension. Can be a comma seperated list.
+with the given extension. Can be a comma separated list.
Specifying 'omit' will restrict the browser to NOT displaying files
-with the given extension. Can be a comma seperated list.
+with the given extension. Can be a comma separated list.
=item * opensearcher(formname, elementname) [javascript]
@@ -235,6 +250,8 @@ 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;
var editbrowser = null;
@@ -244,7 +261,7 @@ sub browser_and_searcher_javascript {
url += 'launch=1&';
}
url += 'catalogmode=interactive&';
- url += 'mode=edit&';
+ url += 'mode=$mode&';
url += 'form=' + formname + '&';
if (only != null) {
url += 'only=' + only + '&';
@@ -269,7 +286,7 @@ sub browser_and_searcher_javascript {
url += 'launch=1&';
}
url += 'catalogmode=interactive&';
- url += 'mode=edit&';
+ url += 'mode=$mode&';
url += 'form=' + formname + '&';
if (titleelement != null) {
url += 'titleelement=' + titleelement + '&';
@@ -353,7 +370,7 @@ sub coursebrowser_javascript {
return (<<ENDSTDBRW);
<script type="text/javascript" language="Javascript" >
var stdeditbrowser;
- function opencrsbrowser(formname,uname,udom) {
+ function opencrsbrowser(formname,uname,udom,desc) {
var url = '/adm/pickcourse?';
var filter;
if (filter != null) {
@@ -368,7 +385,8 @@ sub coursebrowser_javascript {
}
}
url += 'form=' + formname + '&cnumelement='+uname+
- '&cdomelement='+udom;
+ '&cdomelement='+udom+
+ '&cnameelement='+desc;
var title = 'Course_Browser';
var options = 'scrollbars=1,resizable=1,menubar=0';
options += ',width=700,height=600';
@@ -380,9 +398,9 @@ ENDSTDBRW
}
sub selectcourse_link {
- my ($form,$unameele,$udomele)=@_;
+ my ($form,$unameele,$udomele,$desc)=@_;
return "<a href='".'javascript:opencrsbrowser("'.$form.'","'.$unameele.
- '","'.$udomele.'");'."'>".&mt('Select Course')."</a>";
+ '","'.$udomele.'","'.$desc.'");'."'>".&mt('Select Course')."</a>";
}
=pod
@@ -593,8 +611,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"><image src="$helpicon" border="0" alt="(Help: $topic)" /></a>
ENDTEMPLATE
if ($text ne '') { $template.='</td></tr></table>' };
return $template;
@@ -621,6 +640,75 @@ sub helpLatexCheatsheet {
.'</td></tr></table>';
}
+sub help_open_menu {
+ my ($color,$topic,$component_help,$function,$faq,$bug,$stayOnPage,$width,$height,$text) = @_;
+ $text = "" if (not defined $text);
+ $stayOnPage = 0 if (not defined $stayOnPage);
+ if ($ENV{'browser.interface'} eq 'textual' ||
+ $ENV{'environment.remote'} eq 'off' ) {
+ $stayOnPage=1;
+ }
+ $width = 620 if (not defined $width);
+ $height = 600 if (not defined $height);
+ my $link='';
+ my $title = &mt('Get help');
+ my $origurl = $ENV{'REQUEST_URI'};
+ my $timestamp = time;
+ foreach (\$color,\$function,\$topic,\$component_help,\$faq,\$bug,\$origurl) {
+ $$_ = &Apache::lonnet::escape($$_);
+ }
+
+ if (!$stayOnPage) {
+ $link = "javascript:helpMenu('open')";
+ } else {
+ $link = "javascript:helpMenu('display')";
+ }
+ my $banner_link = "/adm/helpmenu?page=banner&color=$color&function=$function&topic=$topic&component_help=$component_help&faq=$faq&bug=$bug&origurl=$origurl&stamp=$timestamp&stayonpage=$stayOnPage";
+ my $details_link = "/adm/helpmenu?page=body&color=$color&function=$function&topic=$topic&component_help=$component_help&faq=$faq&bug=$bug&origurl=$origurl&stamp=$timestamp";
+ my $template;
+ if ($text ne "") {
+ $template .=
+ "<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>
+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()
+ }
+}
+ </script>
+ <a href="$link" title="$title"><image src="$helpicon" border="0" alt="(Help Menu)" /></a>
+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='<table><tr><td>'.
+ &help_open_topic($component_help,$help_text,$stayOnPage,
+ $width,$height).'</td><td>'.$template.
+ '</td></tr></table>';
+ }
+ }
+ if ($text ne '') { $template.='</td></tr></table>' };
+ return $template;
+}
+
sub help_open_bug {
my ($topic, $text, $stayOnPage, $width, $height) = @_;
unless ($ENV{'user.adv'}) { return ''; }
@@ -631,8 +719,8 @@ sub help_open_bug {
$ENV{'environment.remote'} eq 'off' ) {
$stayOnPage=1;
}
- $width = 350 if (not defined $width);
- $height = 400 if (not defined $height);
+ $width = 600 if (not defined $width);
+ $height = 600 if (not defined $height);
$topic=~s/\W+/\+/g;
my $link='';
@@ -657,8 +745,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"><image src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
ENDTEMPLATE
if ($text ne '') { $template.='</td></tr></table>' };
return $template;
@@ -701,8 +790,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"><image src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
ENDTEMPLATE
if ($text ne '') { $template.='</td></tr></table>' };
return $template;
@@ -716,7 +806,7 @@ ENDTEMPLATE
=item * csv_translate($text)
-Translate $text to allow it to be output as a 'comma seperated values'
+Translate $text to allow it to be output as a 'comma separated values'
format.
=cut
@@ -726,7 +816,7 @@ format.
sub csv_translate {
my $text = shift;
$text =~ s/\"/\"\"/g;
- $text =~ s/\n//g;
+ $text =~ s/\n/ /g;
return $text;
}
@@ -777,7 +867,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;
}
@@ -906,21 +996,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<select name='$name' size='$size' multiple='1'>";
- foreach (sort keys %hash) {
- $output.="<option name='$_'".
- ($selected{$_}?' selected="1"' :'').">$hash{$_}</option>\n";
+ foreach (sort(keys(%hash))) {
+ $output.='<option value="'.$_.'" ';
+ $output.='selected ' if ($selected{$_});
+ $output.='>'.$hash{$_}."</option>\n";
}
$output.="</select>\n";
return $output;
@@ -1650,6 +1746,7 @@ sub plainname {
$names{'lastname'}.' '.$names{'generation'};
$name=~s/\s+$//;
$name=~s/\s+/ /g;
+ if ($name !~ /\S/) { $name=$uname.'@'.$udom; }
return $name;
}
@@ -1672,8 +1769,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.'"';
@@ -1699,17 +1807,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
-"<a href='/adm/email?compose=individual&recname=$un&recdom=$do'>$link</a>";
+ '<a href="/adm/email?compose=individual&'.
+ 'recname='.$username.'&recdom='.$domain.'" '.
+ 'title="'.&mt('Send message').'">'.$link.'</a>';
}
# --------------------------------------------------------------- Notes Wrapper
@@ -1722,8 +1834,8 @@ sub noteswrapper {
sub aboutmewrapper {
my ($link,$username,$domain,$target)=@_;
- return "<a href='/adm/$domain/$username/aboutme'".
- ($target?" target='$target'":'').">$link</a>";
+ return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
+ ($target?' target="$target"':'').' title="'.&mt('View this users personal page').'">'.$link.'</a>';
}
# ------------------------------------------------------------ Syllabus Wrapper
@@ -1734,9 +1846,28 @@ sub syllabuswrapper {
if ($fontcolor) {
$linktext='<font color="'.$fontcolor.'">'.$linktext.'</font>';
}
- return "<a href='/public/$domain/$coursedir/syllabus'>$linktext</a>";
+ return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
+}
+
+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{<a href="$link" title="$title" $target>$linktext</a>};
}
+
+
=pod
=back
@@ -1806,6 +1937,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
@@ -1844,7 +1999,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)));
}
@@ -1858,7 +2013,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
@@ -1872,7 +2029,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
@@ -2093,22 +2252,19 @@ show a snapshot of what student was look
=cut
sub get_student_view {
- my ($symb,$username,$domain,$courseid,$target) = @_;
+ my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
- my (%old,%moreenv);
+ my (%form);
my @elements=('symb','courseid','domain','username');
foreach my $element (@elements) {
- $old{$element}=$ENV{'form.grade_'.$element};
- $moreenv{'form.grade_'.$element}=eval '$'.$element #'
+ $form{'grade_'.$element}=eval '$'.$element #'
}
- if ($target eq 'tex') {$moreenv{'form.grade_target'} = 'tex';}
- &Apache::lonnet::appenv(%moreenv);
- $feedurl=&Apache::lonnet::clutter($feedurl);
- my $userview=&Apache::lonnet::ssi_body($feedurl);
- &Apache::lonnet::delenv('form.grade_');
- foreach my $element (@elements) {
- $ENV{'form.grade_'.$element}=$old{$element};
+ if (defined($moreenv)) {
+ %form=(%form,%{$moreenv});
}
+ if ($target eq 'tex') {$form{'grade_target'} = 'tex';}
+ $feedurl=&Apache::lonnet::clutter($feedurl);
+ my $userview=&Apache::lonnet::ssi_body($feedurl,%form);
$userview=~s/\<body[^\>]*\>//gi;
$userview=~s/\<\/body\>//gi;
$userview=~s/\<html\>//gi;
@@ -2131,19 +2287,14 @@ show a snapshot of how student was answe
sub get_student_answers {
my ($symb,$username,$domain,$courseid,%form) = @_;
my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
- my (%old,%moreenv);
+ my (%moreenv);
my @elements=('symb','courseid','domain','username');
foreach my $element (@elements) {
- $old{$element}=$ENV{'form.grade_'.$element};
- $moreenv{'form.grade_'.$element}=eval '$'.$element #'
- }
- $moreenv{'form.grade_target'}='answer';
- &Apache::lonnet::appenv(%moreenv);
- my $userview=&Apache::lonnet::ssi('/res/'.$feedurl,%form);
- &Apache::lonnet::delenv('form.grade_');
- foreach my $element (@elements) {
- $ENV{'form.grade_'.$element}=$old{$element};
+ $moreenv{'grade_'.$element}=eval '$'.$element #'
}
+ $moreenv{'grade_target'}='answer';
+ %moreenv=(%form,%moreenv);
+ my $userview=&Apache::lonnet::ssi('/res/'.$feedurl,%moreenv);
return $userview;
}
@@ -2197,7 +2348,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));
}
#########################################
@@ -2268,10 +2419,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 {
@@ -2408,10 +2557,26 @@ END
'<h1>LON-CAPA: '.$title.'</h1>';
} elsif ($ENV{'environment.remote'} eq 'off') {
# 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'}
+ $ENV{'environment.lastname'}
+ $ENV{'environment.generation'}
+ </font>
+<br />
+<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 bgcolor="'.$tabbg.'"><font face="Arial, Helvetica, sans-serif" size="+3" color="'.$font.'"><b>'.$title.
-'</b></font></td></tr></table>';
+ '<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>';
}
#
@@ -2441,7 +2606,7 @@ $upperleft</td>
</td></tr>
<tr>
<td bgcolor="$tabbg" align="right"><font size="2" face="Arial, Helvetica, sans-serif">$realm</font> </td></tr>
-</table><br>
+</table><br />
ENDBODY
}
@@ -3198,7 +3363,7 @@ plotted in. If undefined, default value
=item $Xlabels: Array ref containing the labels to be used for the X-axis.
=item $Ydata: Array ref containing Array refs.
-Each of the contained arrays will be plotted as a seperate curve.
+Each of the contained arrays will be plotted as a separate curve.
=item %Values: hash indicating or overriding any default values which are
passed to graph.png.
@@ -3536,6 +3701,20 @@ 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();
+}
+
=pod
=back