[LON-CAPA-cvs] cvs: loncom /interface loncommon.pm loncoursegroups.pm lonsimplepage.pm /lonnet/perl lonnet.pm
raeburn
lon-capa-cvs@mail.lon-capa.org
Tue, 22 Nov 2005 00:01:53 -0000
This is a MIME encoded message
--raeburn1132617713
Content-Type: text/plain
raeburn Mon Nov 21 19:01:53 2005 EDT
Modified files:
/loncom/interface loncoursegroups.pm lonsimplepage.pm loncommon.pm
/loncom/lonnet/perl lonnet.pm
Log:
Modify lonnet::get_coursegroups() to return a hash for consistency with other lonnet routines, and move sanity checking functionality to loncommon::coursegroups. Additional routines in lonnet to find out about groups. Some fix-ups to loncoursegroups.pm
--raeburn1132617713
Content-Type: text/plain
Content-Disposition: attachment; filename="raeburn-20051121190153.txt"
Index: loncom/interface/loncoursegroups.pm
diff -u loncom/interface/loncoursegroups.pm:1.3 loncom/interface/loncoursegroups.pm:1.4
--- loncom/interface/loncoursegroups.pm:1.3 Tue Nov 15 17:03:05 2005
+++ loncom/interface/loncoursegroups.pm Mon Nov 21 19:01:41 2005
@@ -123,10 +123,10 @@
$r->print('<br /><br />');
if ($view_permission) {
- if (&Apache::lonnet::get_coursegroups($cdom,$cnum,\%curr_groups) > 0) {
+ my %curr_groups;
+ if (&Apache::loncommon::coursegroups(\%curr_groups,$cdom,$cnum)) {
$r->print(&Apache::lonhtmlcommon::start_pick_box());
- if (keys(%curr_groups) > 0) {
- $r->print(<<"END");
+ $r->print(<<"END");
<table border="0" cellpadding="4" cellspacing="1">
<tr bgcolor="$tabcol" align="center">
<td><b>Action</b></td>
@@ -147,81 +147,95 @@
<td><b><a href="javascript:changeSort('diskuse')">Disk use</a></b></td>
</tr>
END
- my %Sortby = ();
- foreach my $group (sort(keys(%curr_groups))) {
- %{$grp_info{$group}} =
- &Apache::loncommon::get_group_settings(
+ my %Sortby = ();
+ foreach my $group (sort(keys(%curr_groups))) {
+ %{$grp_info{$group}} =
+ &Apache::loncommon::get_group_settings(
$curr_groups{$group});
- my $members_result = &group_members($group,\%grp_info);
- my $files_result = &group_files($group,\%grp_info);
- if ($env{'form.sortby'} eq 'groupname') {
- push(@{$Sortby{$group}},$group);
- } elsif ($env{'form.sortby'} eq 'description') {
- push(@{$Sortby{$grp_info{$group}{'description'}}},
+ my $members_result = &group_members($cdom,$cnum,$group,\%grp_info);
+ my $files_result = &group_files($group,\%grp_info);
+ if ($env{'form.sortby'} eq 'groupname') {
+ push(@{$Sortby{$group}},$group);
+ } elsif ($env{'form.sortby'} eq 'description') {
+ push(@{$Sortby{$grp_info{$group}{'description'}}},
$group);
- } elsif ($env{'form.sortby'} eq 'creator') {
- push(@{$Sortby{$grp_info{$group}{'creator'}}},$group);
- } elsif ($env{'form.sortby'} eq 'creation') {
- push(@{$Sortby{$grp_info{$group}{'creation'}}},$group);
- } elsif ($env{'form.sortby'} eq 'modified') {
- push(@{$Sortby{$grp_info{$group}{'modified'}}},$group);
- } elsif ($env{'form.sortby'} eq 'quota') {
- push(@{$Sortby{$grp_info{$group}{'quota'}}},$group);
- } elsif ($env{'form.sortby'} eq 'totalmembers') {
- push(@{$Sortby{$grp_info{$group}{'totalmembers'}}},
+ } elsif ($env{'form.sortby'} eq 'creator') {
+ push(@{$Sortby{$grp_info{$group}{'creator'}}},$group);
+ } elsif ($env{'form.sortby'} eq 'creation') {
+ push(@{$Sortby{$grp_info{$group}{'creation'}}},$group);
+ } elsif ($env{'form.sortby'} eq 'modified') {
+ push(@{$Sortby{$grp_info{$group}{'modified'}}},$group);
+ } elsif ($env{'form.sortby'} eq 'quota') {
+ push(@{$Sortby{$grp_info{$group}{'quota'}}},$group);
+ } elsif ($env{'form.sortby'} eq 'totalmembers') {
+ push(@{$Sortby{$grp_info{$group}{'totalmembers'}}},
$group);
- } elsif ($env{'form.sortby'} eq 'totalfiles') {
- push(@{$Sortby{$grp_info{$group}{'totalfiles'}}},
+ } elsif ($env{'form.sortby'} eq 'totalfiles') {
+ push(@{$Sortby{$grp_info{$group}{'totalfiles'}}},
$group);
- } elsif ($env{'form.sortby'} eq 'boards') {
- push(@{$Sortby{$grp_info{$group}{'boards'}}},$group);
- } elsif ($env{'form.sortby'} eq 'diskuse') {
- push(@{$Sortby{$grp_info{$group}{'diskuse'}}},$group);
+ } elsif ($env{'form.sortby'} eq 'boards') {
+ push(@{$Sortby{$grp_info{$group}{'boards'}}},$group);
+ } elsif ($env{'form.sortby'} eq 'diskuse') {
+ push(@{$Sortby{$grp_info{$group}{'diskuse'}}},$group);
+ } else {
+ push(@{$Sortby{$group}},$group);
+ }
+ }
+ my $rowNum = 0;
+ my $rowColor;
+ foreach my $key (sort(keys(%Sortby))) {
+ foreach my $group (@{$Sortby{$key}}) {
+ if ($rowNum %2 == 1) {
+ $rowColor = $rowColor1;
} else {
- push(@{$Sortby{$group}},$group);
+ $rowColor = $rowColor2;
}
- }
- my $rowNum = 0;
- my $rowColor;
- foreach my $key (sort(keys(%Sortby))) {
- foreach my $group (@{$Sortby{$key}}) {
- if ($rowNum %2 == 1) {
- $rowColor = $rowColor1;
- } else {
- $rowColor = $rowColor2;
- }
- my $description =
+ my $description =
&Apache::lonnet::unescape($grp_info{$group}{'description'});
- my $creator = $grp_info{$group}{'creator'};
- my $creation = $grp_info{$group}{'creation'};
- my $modified = $grp_info{$group}{'modified'};
- my $quota = $grp_info{$group}{'quota'};
- my $totalmembers = $grp_info{$group}{'totalmembers'};
- my $totalfiles = $grp_info{$group}{'totalfiles'};
- my $boards = $grp_info{$group}{'boards'};
- my $diskuse = $grp_info{$group}{'diskuse'};
- my $functionality;
- foreach my $tool (sort keys(%{$functions})) {
- if (defined($grp_info{$group}{functions}{$tool})) {
- $functionality .= ' '.$tool;
- }
+ my $creator = $grp_info{$group}{'creator'};
+ my $creation = $grp_info{$group}{'creation'};
+ my $modified = $grp_info{$group}{'modified'};
+ my $quota = $grp_info{$group}{'quota'};
+ my $totalmembers = $grp_info{$group}{'totalmembers'};
+ my $totalfiles = $grp_info{$group}{'totalfiles'};
+ my $boards = $grp_info{$group}{'boards'};
+ my $diskuse = $grp_info{$group}{'diskuse'};
+ my $functionality;
+ foreach my $tool (sort keys(%{$functions})) {
+ if (defined($grp_info{$group}{functions}{$tool})) {
+ $functionality .= ' '.$tool;
}
- if (!$functionality) {
- $functionality = 'None available';
- }
- $r->print('<tr bgcolor="'.$rowColor.'"><td align="right">
- <a href="/adm/entergroup?group='.$group.'"/>View</a> <a href="/adm/coursegroups?action=modify&group='.$group.'">Modify</a></td><td><small>'.$group.'</small></td><td><small>'.$description.'</small></td><td><small>'.$creator.'</small></td><td><small>'. &Apache::lonnavmaps::timeToHumanString($creation).'</small></td><td><small>'. &Apache::lonnavmaps::timeToHumanString($modified).'</small></td><td><small>'.$functionality.'</small></td><td><small>'.$quota.'</small></td><td><small>'.$totalmembers.'</small></td><td><small>'.$totalfiles.'</small></td><td><small>'.$boards.'</small></td><td><small>'.$diskuse.'</small></td></tr>');
- $rowNum ++;
}
+ if (!$functionality) {
+ $functionality = 'None available';
+ }
+ $r->print('<tr bgcolor="'.$rowColor.'"><td align="right">
+ <a href="/adm/'.$cdom.'/'.$cnum.'/'.$group.'/grppg?register=1"/>View</a> <a href="/adm/coursegroups?action=modify&group='.$group.'">Modify</a></td><td><small>'.$group.'</small></td><td><small>'.$description.'</small></td><td><small>'.$creator.'</small></td><td><small>'. &Apache::lonnavmaps::timeToHumanString($creation).'</small></td><td><small>'. &Apache::lonnavmaps::timeToHumanString($modified).'</small></td><td><small>'.$functionality.'</small></td><td><small>'.$quota.'</small></td><td><small>'.$totalmembers.'</small></td><td><small>'.$totalfiles.'</small></td><td><small>'.$boards.'</small></td><td><small>'.$diskuse.'</small></td></tr>');
+ $rowNum ++;
}
- $r->print('</table>');
- $r->print(&Apache::lonhtmlcommon::end_pick_box());
- }
+ }
+ $r->print('</table>');
+ $r->print(&Apache::lonhtmlcommon::end_pick_box());
} else {
$r->print('No groups exist');
}
} else {
- $r->print('You do not have sufficient privileges to allow you to display course groups');
+ my @coursegroups = split(/:/,$env{'request.course.groups'});
+ if (@coursegroups > 0) {
+ my %curr_groups;
+ if (&Apache::loncommon::coursegroups(\%curr_groups,$cdom,$cnum)) {
+ foreach my $group (@coursegroups) {
+ my %group_info = &Apache::loncommon::get_group_settings(
+ $curr_groups{$group});
+ my $description = &Apache::lonnet::unescape(
+ $group_info{description});
+ my ($uname,$udom) = split(/:/,$group_info{creator});
+ $r->print('<font size="+1"><a href="/adm/'.$udom.'/'.$uname.'/'.$group.'/grppg?register=1">'.$group,'</a><font><br /><small>'.$description.'</small><br /><br />');
+ }
+ }
+ } else {
+ $r->print('You are not currently a member of any active groups in this course');
+ }
}
return;
}
@@ -563,7 +577,36 @@
}
sub group_members {
- return;
+ my ($cdom,$cnum,$group,$group_info) = @_;
+ my %memberhash = &Apache::lonnet::get_group_membership($cdom,$cnum,$group);
+ my $now = time;
+ my ($tmp)=keys(%memberhash);
+ if ($tmp=~/^error:/) {
+ $$group_info{'totalmembers'} = 'Unknown - an error occurred';
+ return $tmp;
+ }
+ my $now = time;
+ my $totalmembers = 0;
+ my $active = 0;
+ my $previous = 0;
+ my $future = 0;
+ foreach my $member (keys %memberhash) {
+ $totalmembers ++;
+ my ($end,$start) = split(/:/,$memberhash{$member});
+ if (($end!=0) && ($end<$now)) {
+ $previous ++;
+ } elsif (($start!=0) && ($start>$now)) {
+ $future ++;
+ } else {
+ $active ++;
+ }
+ }
+ if ($totalmembers == 0) {
+ $$group_info{$group}{'totalmembers'} = 'None';
+ } else {
+ $$group_info{$group}{'totalmembers'} = $active.' - active<br />'.$previous.' -previous<br />'.$future.' -future';
+ }
+ return 'ok';
}
@@ -789,9 +832,9 @@
['origin','action','state','member','specificity'],\@regexps));
my %sectioncount = ();
my $numsec = &Apache::loncommon::get_sections($cdom,$cnum,\%sectioncount);
- my %curr_groups = ();
- my $numgroups = &Apache::lonnet::get_coursegroups($cdom,$cnum,\%curr_groups);
- my $earlyout = '';
+ my %curr_groups;
+ my $numgroups = &Apache::loncommon::coursegroups(\%curr_groups,$cdom,$cnum);
+ my $earlyout;
my $exitmsg = '<b>Invalid group name</b><br /><br />The group name entered "'.
$groupname.'" ';
my $dupmsg = 'Group names and section names used in a course must be unique.';
@@ -800,8 +843,8 @@
}
if ($numsec) {
if (exists($sectioncount{$groupname})) {
- $earlyout = $exitmsg.'can not be used as it is the name of a section
- in this course.<br />'.$dupmsg;
+ $earlyout = $exitmsg.'can not be used as it is the name of a '.
+ 'section in this course.<br />'.$dupmsg;
}
}
if ($numgroups) {
@@ -1346,9 +1389,9 @@
my %curr_groups = ();
my %groupsettings = ();
my %usersettings = ();
- if (&Apache::lonnet::get_coursegroups($cdom,$cnum,\%curr_groups) > 0) {
+ if (&Apache::loncommon::coursegroups(\%curr_groups,$cdom,$cnum,$groupname)) {
if (exists($curr_groups{$groupname})) {
- $r->print('Non-unique name -please choose another');
+ $r->print('Non-unique name - please choose another');
return;
}
}
Index: loncom/interface/lonsimplepage.pm
diff -u loncom/interface/lonsimplepage.pm:1.30 loncom/interface/lonsimplepage.pm:1.31
--- loncom/interface/lonsimplepage.pm:1.30 Wed Nov 16 08:17:30 2005
+++ loncom/interface/lonsimplepage.pm Mon Nov 21 19:01:41 2005
@@ -1,7 +1,7 @@
# The LearningOnline Network
# Simple Page Editor
#
-# $Id: lonsimplepage.pm,v 1.30 2005/11/16 13:17:30 raeburn Exp $
+# $Id: lonsimplepage.pm,v 1.31 2005/11/22 00:01:41 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -77,12 +77,12 @@
if ($caller eq 'grppg') {
$marker =~ s/\W//g;
$namespace = 'grppage_'.$marker;
- unless(&Apache::lonnet::get_coursegroups($dom,$crs,\%curr_group,
- $marker)) {
+ my %curr_groups;
+ if (!&Apache::loncommon::coursegroups(\%curr_groups,$dom,$crs,$marker)) {
$r->print('<body>Invalid group name</body>');
return OK;
}
- %groupinfo = &Apache::loncommon::get_group_settings($curr_group{$marker});
+ %groupinfo = &Apache::loncommon::get_group_settings($curr_groups{$marker});
} else {
$marker=~s/\D//g;
$namespace = 'smppage_'.$marker;
@@ -139,7 +139,7 @@
(&Apache::loncommon::check_group_access($caller))) {
unless(&Apache::lonnet::allowed('vgh',
$env{'request.course.id'}.'/'.$marker)) {
- &display_group_links($r,$target,$marker,%groupinfo,'view');
+ &display_group_links($r,$target,$marker,'view',%groupinfo);
return OK;
}
} else {
@@ -244,7 +244,7 @@
if ($_ eq 'abb_links' && $caller eq 'grppg') {
$r->print('<br /><input type="hidden" name="'.$_.
'" value="'.$syllabus{$_}.'" />');
- &display_group_links($r,$target,$marker,%groupinfo,'edit');
+ &display_group_links($r,$target,$marker,'edit',%groupinfo);
$r->print('<br />');
} elsif ($_ eq 'aaa_title') {
if ($target ne 'tex') {
@@ -310,9 +310,8 @@
}
sub display_group_links {
- my ($r,$target,$marker,%groupinfo,$context) = @_;
+ my ($r,$target,$marker,$context,%groupinfo) = @_;
my @available = ();
-
my %menu = ();
%{$menu{'email'}} = (
text => 'Group e-mail',
@@ -360,7 +359,7 @@
if ($context eq 'edit') {
$output = 'No group functionality';
} else {
- $output = 'No group functionality (e.g., e-mail, discussion,chat or file upload) is currently available to you in this group: '.$marker;
+ $output = 'No group functionality (e.g., e-mail, discussion, chat or file upload) is currently available to you in this group: '.$marker;
}
if ($target eq 'tex') {
$r->print(&Apache::lonxml::xmlparse($r,'tex',$output));
Index: loncom/interface/loncommon.pm
diff -u loncom/interface/loncommon.pm:1.297 loncom/interface/loncommon.pm:1.298
--- loncom/interface/loncommon.pm:1.297 Mon Nov 21 16:06:59 2005
+++ loncom/interface/loncommon.pm Mon Nov 21 19:01:41 2005
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.297 2005/11/21 21:06:59 raeburn Exp $
+# $Id: loncommon.pm,v 1.298 2005/11/22 00:01:41 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -3084,6 +3084,61 @@
}
###############################################
+
+=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
@@ -3093,7 +3148,7 @@
XML used to describe course groups.
Input:
-Scalar containing XML (as retrieved from &lonnet::get_coursegroups).
+Scalar containing XML - as retrieved from &coursegroups().
Output:
Hash containing group information as key=values for (a), and
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.682 loncom/lonnet/perl/lonnet.pm:1.683
--- loncom/lonnet/perl/lonnet.pm:1.682 Mon Nov 21 14:08:29 2005
+++ loncom/lonnet/perl/lonnet.pm Mon Nov 21 19:01:53 2005
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.682 2005/11/21 19:08:29 raeburn Exp $
+# $Id: lonnet.pm,v 1.683 2005/11/22 00:01:53 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -3703,24 +3703,8 @@
# ------------------------------------------------------- Course Group routines
sub get_coursegroups {
- my ($cdom,$cnum,$curr_groups,$group) = @_;
- my $numgroups = 0;
- %{$curr_groups} = &dump('coursegroups',$cdom,$cnum,$group);
- my ($tmp)=keys(%{$curr_groups});
- if ($tmp eq 'error: 2 tie(GDBM) Failed while attempting dump') {
- my %emptyhash = ();
- if (&put('coursegroups',\%emptyhash,$cdom,$cnum) eq 'ok') {
- %{$curr_groups} = &dump('coursegroups',$cdom,$cnum,$group);
- $tmp=keys(%{$curr_groups});
- }
- }
- if ($tmp=~/^error:/) {
- &logthis('Error retrieving groups: '.$tmp.' in '.$cnum.':'.$cdom);
- } else {
- my @groups = keys(%{$curr_groups});
- $numgroups = @groups;
- }
- return $numgroups;
+ my ($cdom,$cnum,$group) = @_;
+ return(&dump('coursegroups',$cdom,$cnum,$group));
}
sub modify_coursegroup {
@@ -3760,6 +3744,49 @@
return %groups;
}
+sub get_group_membership {
+ my ($cdom,$cnum,$group) = @_;
+ return(&dump('groupmembership',$cdom,$cnum,$group));
+}
+
+sub get_users_groups {
+ my ($udom,$uname,$courseid) = @_;
+ my $cachetime=1800;
+ $courseid=~s/\_/\//g;
+ $courseid=~s/^(\w)/\/$1/;
+
+ my $hashid="$udom:$uname:$courseid";
+ my ($result,$cached)=&is_cached_new('getgroups',$hashid);
+ if (defined($cached)) { return $result; }
+
+ my %roleshash = &dump('roles',$udom,$uname,$courseid);
+ my ($tmp) = keys(%roleshash);
+ if ($tmp=~/^error:/) {
+ &logthis('Error retrieving roles: '.$tmp.' for '.$uname.':'.$udom);
+ return '';
+ } else {
+ my $grouplist;
+ foreach my $key (keys %roleshash) {
+ if ($key =~ /^\Q$courseid\E\/(\w+)\_gr$/) {
+ unless ($roleshash{$key} =~ /_1_1$/) { # deleted membership
+ $grouplist .= $1.':';
+ }
+ }
+ }
+ $grouplist =~ s/:$//;
+ return &do_cache_new('getgroups',$hashid,$grouplist,$cachetime);
+ }
+}
+
+sub devalidate_getgroups_cache {
+ my ($udom,$uname,$cdom,$cnum)=@_;
+ my $courseid = $cdom.'_'.$cnum;
+ $courseid=~s/\_/\//g;
+ $courseid=~s/^(\w)/\/$1/;
+ my $hashid="$udom:$uname:$courseid";
+ &devalidate_cache_new('getgroups',$hashid);
+}
+
# ------------------------------------------------------------------ Plain Text
sub plaintext {
--raeburn1132617713--