--- loncom/interface/loncommon.pm 2005/11/10 00:37:39 1.286
+++ loncom/interface/loncommon.pm 2005/12/01 23:04:08 1.300
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.286 2005/11/10 00:37:39 banghart Exp $
+# $Id: loncommon.pm,v 1.300 2005/12/01 23:04:08 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -380,7 +380,7 @@ sub coursebrowser_javascript {
return (<<ENDSTDBRW);
<script type="text/javascript" language="Javascript" >
var stdeditbrowser;
- function opencrsbrowser(formname,uname,udom,desc,extra_element) {
+ function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag) {
var url = '/adm/pickcourse?';
var filter;
if (filter != null) {
@@ -403,6 +403,9 @@ sub coursebrowser_javascript {
url += '&domainfilter='+extra_element;
}
}
+ if (multflag !=null && multflag != '') {
+ url += '&multiple='+multflag;
+ }
var title = 'Course_Browser';
var options = 'scrollbars=1,resizable=1,menubar=0';
options += ',width=700,height=600';
@@ -414,9 +417,9 @@ ENDSTDBRW
}
sub selectcourse_link {
- my ($form,$unameele,$udomele,$desc,$extra_element)=@_;
+ my ($form,$unameele,$udomele,$desc,$extra_element,$multflag)=@_;
return "<a href='".'javascript:opencrsbrowser("'.$form.'","'.$unameele.
- '","'.$udomele.'","'.$desc.'","'.$extra_element.'");'."'>".&mt('Select Course')."</a>";
+ '","'.$udomele.'","'.$desc.'","'.$extra_element.'","'.$multflag.'");'."'>".&mt('Select Course')."</a>";
}
sub check_uncheck_jscript {
@@ -1149,7 +1152,7 @@ sub domain_select {
} &get_domains;
if ($multiple) {
$domains{''}=&mt('Any domain');
- return &multiple_select_form($name,$value,4,%domains);
+ return &multiple_select_form($name,$value,4,\%domains);
} else {
return &select_form($name,$value,%domains);
}
@@ -1159,7 +1162,7 @@ sub domain_select {
=pod
-=item * multiple_select_form($name,$value,$size,%hash)
+=item * multiple_select_form($name,$value,$size,$hash,$order)
Returns a string containing a <select> element int multiple mode
@@ -1917,12 +1920,11 @@ if $first is set to 'lastname' then it r
=cut
+
###############################################################
sub plainname {
my ($uname,$udom,$first)=@_;
- my %names=&Apache::lonnet::get('environment',
- ['firstname','middlename','lastname','generation'],
- $udom,$uname);
+ my %names=&getnames($uname,$udom);
my $name=&Apache::lonnet::format_name($names{'firstname'},
$names{'middlename'},
$names{'lastname'},
@@ -1953,19 +1955,7 @@ if the user does not
sub nickname {
my ($uname,$udom)=@_;
- 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 %names=&getnames($uname,$udom);
my $name=$names{'nickname'};
if ($name) {
$name='"'.$name.'"';
@@ -1978,6 +1968,20 @@ sub nickname {
return $name;
}
+sub getnames {
+ my ($uname,$udom)=@_;
+ my $id=$uname.':'.$udom;
+ my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
+ if ($cached) {
+ return %{$names};
+ } else {
+ my %loadnames=&Apache::lonnet::get('environment',
+ ['firstname','middlename','lastname','generation','nickname'],
+ $udom,$uname);
+ &Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
+ return %loadnames;
+ }
+}
# ------------------------------------------------------------------ Screenname
@@ -2775,8 +2779,8 @@ sub bodytag {
h1, h2, h3, th { font-family: Arial, Helvetica, sans-serif }
a:focus { color: red; background: yellow }
table.thinborder { border-collapse: collapse; }
-table.thinborder tr th { border-style: solid; border-width: 1px}
-table.thinborder tr td { border-style: solid; border-width: 1px}
+table.thinborder tr th, table.thinborder tr td { border-style: solid; border-width: 1px}
+form, .inline { display: inline; }
.center { text-align: center; }
</style>
<body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link"
@@ -2886,7 +2890,7 @@ ENDROLE
#
return(<<ENDBODY);
$bodytag
-<table class="thinborder" width="100%" cellspacing="0" border="0" cellpadding="0">
+<table width="100%" cellspacing="0" border="0" cellpadding="0">
<tr><td bgcolor="$sidebg">
$upperleft</td>
<td bgcolor="$sidebg" align="right">$messages </td>
@@ -3080,6 +3084,138 @@ sub get_sections {
}
###############################################
+
+=pod
+
+=item coursegroups
+
+Retrieve information about groups in a course,
+
+Input:
+1. Reference to hash to populate with group information.
+2. Optional course domain
+3. Optional course number
+4. Optional group name
+
+Course domain and number will be taken from user's
+environment if not supplied. Optional group name will'
+be passed to lonnet::get_coursegroups() as a regexp to
+use in the call to the dump function.
+
+Output
+Returns number of groups in the course (subject to the
+optional group name filter).
+
+Side effects:
+Populates the referenced curr_groups hash, with key,
+value pairs. Keys are group names, corresponding values
+are scalars containing group information in XML. This
+can be sent to &get_group_settings() to be parsed.
+
+=cut
+
+###############################################
+
+sub coursegroups {
+ my ($curr_groups,$cdom,$cnum,$group) = @_;
+ my $numgroups;
+ if (!defined($cdom) || !defined($cnum)) {
+ my $cid = $env{'request.course.id'};
+ $cdom = $env{'course.'.$cid.'.domain'};
+ $cnum = $env{'course.'.$cid.'.num'};
+ }
+ %{$curr_groups} = &Apache::lonnet::get_coursegroups($cdom,$cnum,$group);
+ my ($tmp) = keys(%{$curr_groups});
+ if ($tmp=~/^error:/) {
+ unless ($tmp eq 'error: 2 tie(GDBM) Failed while attempting dump') {
+ &logthis('Error retrieving groups: '.$tmp.' in '.$cnum.':'.
+ $cdom);
+ }
+ $numgroups = 0;
+ } else {
+ $numgroups = keys(%{$curr_groups});
+ }
+ return $numgroups;
+}
+
+###############################################
+
+=pod
+
+=item get_group_settings
+
+Uses TokeParser to extract group information from the
+XML used to describe course groups.
+
+Input:
+Scalar containing XML - as retrieved from &coursegroups().
+
+Output:
+Hash containing group information as key=values for (a), and
+hash of hashes for (b)
+
+Keys (in two categories):
+(a) groupname, creator, creation, modified, startdate,enddate.
+Corresponding values are name of the group, creator of the group
+(username:domain), UNIX time for date group was created, and
+settings were last modified, and default start and end access
+times for group members.
+
+(b) functions returned in hash of hashes.
+Outer hash key is functions.
+Inner hash keys are chat,discussion,email,files,homepage,roster.
+Corresponding values are either on or off, depending on
+whther this type of functionality is available for the group.
+
+=cut
+
+###############################################
+
+sub get_group_settings {
+ my ($groupinfo)=@_;
+ my $parser=HTML::TokeParser->new(\$groupinfo);
+ my $token;
+ my $tool = '';
+ my %content=();
+ while ($token=$parser->get_token) {
+ if ($token->[0] eq 'S') {
+ my $entry=$token->[1];
+ if ($entry eq 'functions') {
+ %{$content{$entry}} = ();
+ $tool = $entry;
+ } else {
+ my $value=$parser->get_text('/'.$entry);
+ if ($entry eq 'name') {
+ if ($tool eq 'functions') {
+ my $function = $token->[2]{id};
+ $content{$tool}{$function} = $value;
+ }
+ } elsif ($entry eq 'groupname') {
+ $content{$entry}=&Apache::lonnet::unescape($value);
+ } else {
+ $content{$entry}=$value;
+ }
+ }
+ } elsif ($token->[0] eq 'E') {
+ if ($token->[1] eq 'functions') {
+ $tool = '';
+ }
+ }
+ }
+ return %content;
+}
+
+sub check_group_access {
+ my ($group) = @_;
+ my $access = 1;
+ my $now = time;
+ my ($start,$end) = split(/\./,$env{'user.role.gr/'.$env{'request.course,id'}.'/'.$group});
+ if (($end!=0) && ($end<$now)) { $access = 0; }
+ if (($start!=0) && ($start>$now)) { $access=0; }
+ return $access;
+}
+
+###############################################
=pod
@@ -3094,64 +3230,108 @@ Incoming parameters:
3. access status: users must have - either active,
previous, future, or all.
4. reference to array of permissible roles
-5. reference to results object (hash of hashes).
+5. reference to array of section restrictions (optional)
+6. reference to results object (hash of hashes).
+7. reference to optional userdata hash
Keys of top level hash are roles.
Keys of inner hashes are username:domain, with
values set to access type.
-
+Optional userdata hash returns an array with arguments in the
+same order as loncoursedata::get_classlist() for student data.
+
+Entries for end, start, section and status are blank because
+of the possibility of multiple values for non-student roles.
+
=cut
###############################################
sub get_course_users {
- my ($cdom,$cnum,$types,$roles,$users) = @_;
- if (grep/^st$/,@{$roles}) {
- my $statusidx = &Apache::loncoursedata::CL_STATUS();
- my $startidx = &Apache::loncoursedata::CL_START();
- my $endidx = &Apache::loncoursedata::CL_END();
+ my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata) = @_;
+ my %idx = ();
+
+ $idx{udom} = &Apache::loncoursedata::CL_SDOM();
+ $idx{uname} = &Apache::loncoursedata::CL_SNAME();
+ $idx{end} = &Apache::loncoursedata::CL_END();
+ $idx{start} = &Apache::loncoursedata::CL_START();
+ $idx{id} = &Apache::loncoursedata::CL_ID();
+ $idx{section} = &Apache::loncoursedata::CL_SECTION();
+ $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
+ $idx{status} = &Apache::loncoursedata::CL_STATUS();
+
+ if (grep(/^st$/,@{$roles})) {
my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
my $now = time;
foreach my $student (keys(%{$classlist})) {
+ my $match = 0;
+ if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
+ unless(grep(/^\Q$$classlist{$student}[$idx{section}]\E$/,
+ @{$sections})) {
+ next;
+ }
+ }
if (defined($$types{'active'})) {
- if ($$classlist{$student}[$statusidx] eq 'Active') {
+ if ($$classlist{$student}[$idx{status}] eq 'Active') {
push(@{$$users{st}{$student}},'active');
+ $match = 1;
}
}
if (defined($$types{'previous'})) {
- if ($$classlist{$student}[$endidx] <= $now) {
+ if ($$classlist{$student}[$idx{end}] <= $now) {
push(@{$$users{st}{$student}},'previous');
+ $match = 1;
}
}
if (defined($$types{'future'})) {
- if (($$classlist{$student}[$startidx] > $now) && ($$classlist{$student}[$endidx] > $now) || ($$classlist{$student}[$endidx] == 0) || ($$classlist{$student}[$endidx] eq '')) {
+ if (($$classlist{$student}[$idx{start}] > $now) && ($$classlist{$student}[$idx{end}] > $now) || ($$classlist{$student}[$idx{end}] == 0) || ($$classlist{$student}[$idx{end}] eq '')) {
push(@{$$users{st}{$student}},'future');
+ $match = 1;
}
}
+ if ($match && defined($userdata)) {
+ $$userdata{$student} = $$classlist{$student};
+ }
}
}
if ((@{$roles} > 0) && (@{$roles} ne "st")) {
my @coursepersonnel = &Apache::lonnet::getkeys('nohist_userroles',$cdom,$cnum);
foreach my $person (@coursepersonnel) {
+ my $match = 0;
my ($role,$user) = ($person =~ /^([^:]*):([^:]+:[^:]+)/);
$user =~ s/:$//;
- if (($role) && (grep(/^$role$/,@{$roles}))) {
- my ($uname,$udom) = split(/:/,$user);
+ if (($role) && (grep(/^\Q$role\E$/,@{$roles}))) {
+ my ($uname,$udom,$usec) = split(/:/,$user);
+ if ($usec ne '' && (ref($sections) eq 'ARRAY') &&
+ @{$sections} > 0) {
+ unless(grep(/^\Q$usec\E$/,@{$sections})) {
+ next;
+ }
+ }
if ($uname ne '' && $udom ne '') {
my $status = &check_user_status($udom,$uname,$cdom,$cnum,$role);
foreach my $type (keys(%{$types})) {
if ($status eq $type) {
- $$users{$role}{$user} = $type;
+ @{$$users{$role}{$user}} = $type;
+ $match = 1;
}
}
+ if ($match && defined($userdata) &&
+ !exists($$userdata{$uname.':'.$udom})) {
+ &get_user_info($udom,$uname,\%idx,$userdata);
+ }
}
}
}
- if (grep/^ow$/,@{$roles}) {
+ if (grep(/^ow$/,@{$roles})) {
if ((defined($cdom)) && (defined($cnum))) {
my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
if ( defined($csettings{'internal.courseowner'}) ) {
my $owner = $csettings{'internal.courseowner'};
- $$users{'ow'}{$owner.':'.$cdom} = 'any';
+ @{$$users{'ow'}{$owner.':'.$cdom}} = 'any';
+ if (defined($userdata) &&
+ !exists($$userdata{$owner.':'.$cdom})) {
+ &get_user_info($cdom,$owner,\%idx,$userdata);
+ }
}
}
}
@@ -3159,7 +3339,14 @@ sub get_course_users {
return;
}
-
+sub get_user_info {
+ my ($udom,$uname,$idx,$userdata) = @_;
+ $$userdata{$uname.':'.$udom}[$$idx{fullname}] =
+ &plainname($uname,$udom,'lastname');
+ $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
+ $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
+ return;
+}
###############################################
@@ -3299,6 +3486,10 @@ sub no_cache {
sub content_type {
my ($r,$type,$charset) = @_;
+ if ($r) {
+ # Note that printout.pl calls this with undef for $r.
+ &no_cache($r);
+ }
if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
unless ($charset) {
$charset=&Apache::lonlocal::current_encoding;
@@ -4164,13 +4355,14 @@ sub store_course_settings {
# save to the environment
# appenv the same items, just to be safe
my $courseid = $env{'request.course.id'};
- my $coursedom = $env{'course.'.$courseid.'.domain'};
+ my $udom = $env{'user.domain'};
+ my $uname = $env{'user.name'};
my ($prefix,$Settings) = @_;
my %SaveHash;
my %AppHash;
while (my ($setting,$type) = each(%$Settings)) {
- my $basename = 'internal.'.$prefix.'.'.$setting;
- my $envname = 'course.'.$courseid.'.'.$basename;
+ my $basename = join('.','internal',$courseid,$prefix,$setting);
+ my $envname = 'environment.'.$basename;
if (exists($env{'form.'.$setting})) {
# Save this value away
if ($type eq 'scalar' &&
@@ -4198,8 +4390,7 @@ sub store_course_settings {
}
}
my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
- $coursedom,
- $env{'course.'.$courseid.'.num'});
+ $udom,$uname);
if ($put_result !~ /^(ok|delayed)/) {
&Apache::lonnet::logthis('unable to save form parameters, '.
'got error:'.$put_result);
@@ -4214,7 +4405,7 @@ sub restore_course_settings {
my ($prefix,$Settings) = @_;
while (my ($setting,$type) = each(%$Settings)) {
next if (exists($env{'form.'.$setting}));
- my $envname = 'course.'.$courseid.'.internal.'.$prefix.
+ my $envname = 'environment.internal.'.$courseid.'.'.$prefix.
'.'.$setting;
if (exists($env{$envname})) {
if ($type eq 'scalar') {