--- loncom/interface/loncommon.pm 2002/08/22 21:02:49 1.57
+++ loncom/interface/loncommon.pm 2002/10/18 13:49:49 1.70
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.57 2002/08/22 21:02:49 albertel Exp $
+# $Id: loncommon.pm,v 1.70 2002/10/18 13:49:49 www Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -98,6 +98,10 @@ my %cprtag;
my %fe; my %fd;
my %category_extensions;
+# ---------------------------------------------- Designs
+
+my %designhash;
+
# ---------------------------------------------- Thesaurus variables
=pod
@@ -166,6 +170,30 @@ BEGIN {
}
}
}
+
+# -------------------------------------------------------------- domain designs
+
+ my $filename;
+ my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
+ opendir(DIR,$designdir);
+ while ($filename=readdir(DIR)) {
+ my ($domain)=($filename=~/^(\w+)\./);
+ {
+ my $fh=Apache::File->new($designdir.'/'.$filename);
+ if ($fh) {
+ while (<$fh>) {
+ next if /^\#/;
+ chomp;
+ my ($key,$val)=(split(/\=/,$_));
+ if ($val) { $designhash{$domain.'.'.$key}=$val; }
+ }
+ }
+ }
+
+ }
+ closedir(DIR);
+
+
# ------------------------------------------------------------- file categories
{
my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
@@ -755,6 +783,8 @@ sub authform_kerberos{
Kerberos authenticated with domain
+Version 4
+Version 5
END
return $result;
}
@@ -930,6 +960,71 @@ sub get_related_words {
## End Thesaurus Functions ##
###############################################################
+# -------------------------------------------------------------- Plaintext name
+
+sub plainname {
+ my ($uname,$udom)=@_;
+ my %names=&Apache::lonnet::get('environment',
+ ['firstname','middlename','lastname','generation'],
+ $udom,$uname);
+ my $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
+ $names{'lastname'}.' '.$names{'generation'};
+ $name=~s/\s+$//;
+ $name=~s/\s+/ /g;
+ return $name;
+}
+
+# -------------------------------------------------------------------- Nickname
+
+
+sub nickname {
+ my ($uname,$udom)=@_;
+ my %names=&Apache::lonnet::get('environment',
+ ['nickname','firstname','middlename','lastname','generation'],$udom,$uname);
+ my $name=$names{'nickname'};
+ if ($name) {
+ $name='"'.$name.'"';
+ } else {
+ $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
+ $names{'lastname'}.' '.$names{'generation'};
+ $name=~s/\s+$//;
+ $name=~s/\s+/ /g;
+ }
+ return $name;
+}
+
+
+# ------------------------------------------------------------------ Screenname
+
+sub screenname {
+ my ($uname,$udom)=@_;
+ my %names=
+ &Apache::lonnet::get('environment',['screenname'],$udom,$uname);
+ return $names{'screenname'};
+}
+
+# ------------------------------------------------------------- Message Wrapper
+
+sub messagewrapper {
+ my ($link,$un,$do)=@_;
+ return
+"$link";
+}
+# ------------------------------------------------------------- Aboutme Wrapper
+
+sub aboutmewrapper {
+ my ($link,$username,$domain)=@_;
+ return "$link";
+}
+
+# ------------------------------------------------------------ Syllabus Wrapper
+
+
+sub syllabuswrapper {
+ my ($link,$un,$do)=@_;
+ return "$link";
+}
+
# ---------------------------------------------------------------- Language IDs
sub languageids {
return sort(keys(%language));
@@ -1059,7 +1154,7 @@ sub get_previous_attempt {
}
sub get_student_view {
- my ($symb,$username,$domain,$courseid) = @_;
+ my ($symb,$username,$domain,$courseid,$target) = @_;
my ($map,$id,$feedurl) = split(/___/,$symb);
my (%old,%moreenv);
my @elements=('symb','courseid','domain','username');
@@ -1067,6 +1162,7 @@ sub get_student_view {
$old{$element}=$ENV{'form.grade_'.$element};
$moreenv{'form.grade_'.$element}=eval '$'.$element #'
}
+ if ($target eq 'tex') {$moreenv{'form.grade_target'} = 'tex';}
&Apache::lonnet::appenv(%moreenv);
my $userview=&Apache::lonnet::ssi('/res/'.$feedurl);
&Apache::lonnet::delenv('form.grade_');
@@ -1126,6 +1222,22 @@ sub maketime {
}
+#########################################
+#
+# Retro-fixing of un-backward-compatible time format
+
+sub unsqltime {
+ my $timestamp=shift;
+ if ($timestamp=~/^(\d+)\-(\d+)\-(\d+)\s+(\d+)\:(\d+)\:(\d+)$/) {
+ $timestamp=&maketime(
+ 'year'=>$1,'month'=>$2,'day'=>$3,
+ 'hours'=>$4,'minutes'=>$5,'seconds'=>$6);
+ }
+ return $timestamp;
+}
+
+#########################################
+
sub findallcourses {
my %courses=();
my $now=time;
@@ -1146,9 +1258,106 @@ sub findallcourses {
}
###############################################
+###############################################
+
+=pod
+
+=item &determinedomain()
+
+Inputs: $domain (usually will be undef)
+
+Returns: Determines which domain should be used for designs
+
+=cut
+
+###############################################
+sub determinedomain {
+ my $domain=shift;
+ if (! $domain) {
+ # Determine domain if we have not been given one
+ $domain = $Apache::lonnet::perlvar{'lonDefDomain'};
+ if ($ENV{'user.domain'}) { $domain=$ENV{'user.domain'}; }
+ if ($ENV{'request.role.domain'}) {
+ $domain=$ENV{'request.role.domain'};
+ }
+ }
+ return $domain;
+}
+###############################################
+=pod
+
+=item &domainlogo()
+
+Inputs: $domain (usually will be undef)
+
+Returns: A link to a domain logo, if the domain logo exists.
+If the domain logo does not exist, a description of the domain.
+
+=cut
+###############################################
+sub domainlogo {
+ my $domain = &determinedomain(shift);
+ # See if there is a logo
+ if (-e '/home/httpd/html/adm/lonDomLogos/'.$domain.'.gif') {
+ return '';
+ } elsif(exists($Apache::lonnet::domaindescription{$domain})) {
+ return $Apache::lonnet::domaindescription{$domain};
+ } else {
+ return '';
+ }
+}
+##############################################
+
+=pod
+
+=item &designparm()
+
+Inputs: $which parameter; $domain (usually will be undef)
+
+Returns: value of designparamter $which
+
+=cut
+##############################################
+sub designparm {
+ my ($which,$domain)=@_;
+ $domain=&determinedomain($domain);
+ if ($designhash{$domain.'.'.$which}) {
+ return $designhash{$domain.'.'.$which};
+ } else {
+ return $designhash{'default.'.$which};
+ }
+}
+
+###############################################
+###############################################
+
+=pod
+
+=item &bodytag()
+
+Returns a uniform header for LON-CAPA web pages.
+
+Inputs:
+
+ $title, A title to be displayed on the page.
+ $function, the current role (can be undef).
+ $addentries, extra parameters for the