[LON-CAPA-cvs] cvs: loncom /interface loncommon.pm

Stuart Peter Raeburn raeburn <lon-capa-cvs-allow@mail.lon-capa.org>
Tue, 06 Nov 2007 12:24:56 -0500


raeburn         Mon Nov 5 23:39:19 2007 EDT
 Modified files:
 /loncom/interface     loncommon.pm lonhtmlcommon.pm
                       loncoursedata.pm loncreateuser.pm
                       lonpickcourse.pm
 Log:
Bug 5422
More comprehensive listing of LON-CAPA users.  Available to Domain 
Coordinators, Authors and Course Coordinators. Lists displayable in HTML, 
CSV or Excel formats.
 - filter by status and role.
 - DCs can specify a subset of courses for display of course roles. 

loncommon.pm
 - &linked_select_forms() can take an additional argument ($menuorder) which 
specifies order of items in the first select box.
 - %menuhash can include hash key,value pair: order = reference to array
   (order of contents of the second select box) as optional item.
 - get_course_users() has new optional arg (statushash) to return information 
about status (Expired, Active or Future) for each section for user's roles.
 - studentID information now included in optional hash of user information 
for course users. 

lonhtmlcommon.pm
 - &course_selection() routine split from &course_select_row() to allow reuse 
when selecting course filter for DC's listing of user roles. 

loncoursedata.pm
 - Three subroutines added to return indices for permanentemail, role and 
extent, so user listings in lonuserutils:;show_user_lists() can sort by 
these using the existing sorting code. 

loncreateuser.pm
 - display of user lists included in menu on first page.
 - some wording changes (as per bug 5506)
 - switches on $env{'form.state'} for call to &print_userlist() eliminated 
(not needed).
 - course selector included when in DC context 

lonpickcourse.pm
 - domain selector defaults to domain of user's role when course selector 
used for studentform. 

Work in progress - role expiration and section switching still to be added 
to interface. 


 --- loncom/interface/loncommon.pm	2007/11/06 02:23:49	1.608
+++ loncom/interface/loncommon.pm	2007/11/06 04:39:19	1.609
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
 -# $Id: loncommon.pm,v 1.608 2007/11/06 02:23:49 albertel Exp $
+# $Id: loncommon.pm,v 1.609 2007/11/06 04:39:19 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -544,7 +544,7 @@ linked_select_forms returns a string con
and html for two <select> menus.  The select menus will be linked in that
changing the value of the first menu will result in new values being placed
in the second menu.  The values in the select menu will appear in 
alphabetical
 -order.
+order unless a defined order is provided. 

linked_select_forms takes the following ordered inputs: 

@@ -562,6 +562,8 @@ linked_select_forms takes the following 

=item * $hashref, a reference to a hash containing the data for the menus. 

+=item * $menuorder, the order of values in the first menu
+
=back 

Below is an example of such a hash.  Only the 'text', 'default', and
@@ -578,7 +580,8 @@ $menu{$choice1}->{'select2'}.
                           B2 => "Choice B2",
                           B3 => "Choice B3",
                           B4 => "Choice B4"
 -                           }
+                           },
+                       order => ['B4','B3','B1','B2'],
                   },
               A2 => { text =>"Choice A2" ,
                       default => "C2",
@@ -586,7 +589,8 @@ $menu{$choice1}->{'select2'}.
                           C1 => "Choice C1",
                           C2 => "Choice C2",
                           C3 => "Choice C3"
 -                           }
+                           },
+                       order => ['C2','C1','C3'],
                   },
               A3 => { text =>"Choice A3" ,
                       default => "D6",
@@ -598,7 +602,8 @@ $menu{$choice1}->{'select2'}.
                           D5 => "Choice D5",
                           D6 => "Choice D6",
                           D7 => "Choice D7"
 -                           }
+                           },
+                       order => ['D4','D3','D2','D1','D7','D6','D5'],
                   }
               ); 

@@ -610,7 +615,8 @@ sub linked_select_forms {
        $firstdefault,
        $firstselectname,
        $secondselectname,
 -        $hashref
+        $hashref,
+        $menuorder,
        ) = @_;
    my $second = "document.$formname.$secondselectname";
    my $first = "document.$formname.$firstselectname";
@@ -624,8 +630,11 @@ sub linked_select_forms {
        $result.="select2data.d_$s1 = new Object();\n";
        $result.="select2data.d_$s1.def = new String('".
            $hashref->{$s1}->{'default'}."');\n";
 -        $result.="select2data.d_$s1.values = new Array(";
+        $result.="select2data.d_$s1.values = new Array(";
        my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
+        if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
+            @s2values = @{$hashref->{$s1}->{'order'}};
+        }
        $result.="\"@s2values\");\n";
        $result.="select2data.d_$s1.texts = new Array(";
        my @s2texts;
@@ -663,7 +672,11 @@ function select1_changed() {
END
    # output the initial values for the selection lists
    $result .= "<select size=\"1\" name=\"$firstselectname\" 
onchange=\"select1_changed()\">\n";
 -    foreach my $value (sort(keys(%$hashref))) {
+    my @order = sort(keys(%{$hashref}));
+    if (ref($menuorder) eq 'ARRAY') {
+        @order = @{$menuorder};
+    }
+    foreach my $value (@order) {
        $result.="    <option value=\"$value\" ";
        $result.=" selected=\"selected\" " if ($value eq $firstdefault);
        $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
@@ -673,7 +686,12 @@ END
    $result .= $middletext;
    $result .= "<select size=\"1\" name=\"$secondselectname\">\n";
    my $seconddefault = $hashref->{$firstdefault}->{'default'};
 -    foreach my $value (sort(keys(%select2))) {
+
+    my @secondorder = sort(keys(%select2));
+    if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
+        @secondorder = @{$hashref->{$firstdefault}->{'order'}};
+    }
+    foreach my $value (@secondorder) {
        $result.="    <option value=\"$value\" ";
        $result.=" selected=\"selected\" " if ($value eq $seconddefault);
        $result.=">".&mt($select2{$value})."</option>\n";
@@ -5797,12 +5815,15 @@ previous, future, or all.
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.
+8. reference to optional statushash
+Keys of top level results 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. 

+Optional statushash returns
+
Entries for end, start, section and status are blank because
of the possibility of multiple values for non-student roles. 

@@ -5811,7 +5832,7 @@ of the possibility of multiple values fo
############################################### 

sub get_course_users {
 -    my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata) = @_;
+    my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash) = 
@_;
    my %idx = ();
    my %seclists; 

@@ -5828,9 +5849,11 @@ sub get_course_users {
        my 
($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
        my $now = time;
        foreach my $student (keys(%{$classlist})) {
+            my $status;
            my $match = 0;
            my $secmatch = 0;
            my $section = $$classlist{$student}[$idx{section}];
+            my $status = $$classlist{$student}[$idx{status}];
            if ($section eq '') {
                $section = 'none';
            }
@@ -5850,7 +5873,6 @@ sub get_course_users {
                    next;
                }
            }
 -            push(@{$seclists{$student}},$section);
            if (defined($$types{'active'})) {
                if ($$classlist{$student}[$idx{status}] eq 'Active') {
                    push(@{$$users{st}{$student}},'active');
@@ -5858,25 +5880,35 @@ sub get_course_users {
                }
            }
            if (defined($$types{'previous'})) {
 -                if ($$classlist{$student}[$idx{end}] <= $now) {
+                if ($$classlist{$student}[$idx{status}] eq 'Expired') {
                    push(@{$$users{st}{$student}},'previous');
                    $match = 1;
                }
            }
            if (defined($$types{'future'})) {
 -                if (($$classlist{$student}[$idx{start}] > $now) && 
($$classlist{$student}[$idx{end}] > $now) || 
($$classlist{$student}[$idx{end}] == 0) || ($$classlist{$student}[$idx{end}] 
eq '')) {
+                if ($$classlist{$student}[$idx{status}] eq 'Future') {
                    push(@{$$users{st}{$student}},'future');
                    $match = 1;
                }
            }
 -            if ($match && ref($userdata) eq 'HASH') {
 -                $$userdata{$student} = $$classlist{$student};
+            if ($match) {
+                push(@{$seclists{$student}},$section);
+                if (ref($userdata) eq 'HASH') {
+                    $$userdata{$student} = $$classlist{$student};
+                }
+                if (ref($statushash) eq 'HASH') {
+                    $statushash->{$student}{'st'}{$section} = $status;
+                }
            }
        }
    }
    if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
        my %coursepersonnel = 
&Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
        my $now = time;
+        my %displaystatus = ( previous => 'Expired',
+                              active   => 'Active',
+                              future   => 'Future',
+                            );
        foreach my $person (sort(keys(%coursepersonnel))) {
            my $match = 0;
            my $secmatch = 0;
@@ -5932,6 +5964,9 @@ sub get_course_users {
                        if 
(!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
                            push(@{$seclists{$uname.':'.$udom}},$usec);
                        }
+                        if (ref($statushash) eq 'HASH') {
+                            $statushash->{$uname.':'.$udom}{$role}{$usec} = 
$displaystatus{$status};
+                        }
                    }
                }
            }
@@ -5941,15 +5976,25 @@ sub get_course_users {
                my %csettings = 
&Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
                if ( defined($csettings{'internal.courseowner'}) ) {
                    my $owner = $csettings{'internal.courseowner'};
 -                    if ($owner !~ /^[^:]+:[^:]+$/) {
 -                        $owner = $owner.':'.$cdom;
+                    next if ($owner eq '');
+                    my ($ownername,$ownerdom);
+                    if ($owner =~ /^([^:]+):([^:]+)$/) {
+                        $ownername = $1;
+                        $ownerdom = $2;
+                    } else {
+                        $ownername = $owner;
+                        $ownerdom = $cdom;
+                        $owner = $ownername.':'.$ownerdom;
                    }
                    @{$$users{'ow'}{$owner}} = 'any';
                    if (defined($userdata) &&
 -			!exists($$userdata{$owner.':'.$cdom})) {
 -			&get_user_info($cdom,$owner,\%idx,$userdata);
 -                        if (!grep(/^none$/,@{$seclists{$owner.':'.$cdom}})) 
{
 -                            push(@{$seclists{$owner.':'.$cdom}},'none');
+			!exists($$userdata{$owner})) {
+			&get_user_info($ownerdom,$ownername,\%idx,$userdata);
+                        if (!grep(/^none$/,@{$seclists{$owner}})) {
+                            push(@{$seclists{$owner}},'none');
+                        }
+                        if (ref($statushash) eq 'HASH') {
+                            $statushash->{$owner}{'ow'}{'none'} = 'Any';
                        }
		    }
                }
@@ -5969,6 +6014,8 @@ sub get_user_info {
	&plainname($uname,$udom,'lastname');
    $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
    $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
+    my %idhash =  &Apache::lonnet::idrget($udom,($uname));
+    $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname};
    return;
} 

 --- loncom/interface/lonhtmlcommon.pm	2007/11/02 23:41:01	1.168
+++ loncom/interface/lonhtmlcommon.pm	2007/11/06 04:39:19	1.169
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common html routines
#
 -# $Id: lonhtmlcommon.pm,v 1.168 2007/11/02 23:41:01 albertel Exp $
+# $Id: lonhtmlcommon.pm,v 1.169 2007/11/06 04:39:19 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -1473,7 +1473,14 @@ sub course_select_row {
    my ($title,$formname,$totcodes,$codetitles,$idlist,$idlist_titles,
	$css_class) = @_;
    my $output = &row_title($title,$css_class);
 -    $output .= qq|
+    $output .= 
&course_selection($formname,$totcodes,$codetitles,$idlist,$idlist_titles);
+    $output .= &row_closure();
+    return $output;
+}
+
+sub course_selection {
+    my ($formname,$totcodes,$codetitles,$idlist,$idlist_titles) = @_;
+    my $output = qq|
<script type="text/javascript">
    function coursePick (formname) {
        for  (var i=0; i<formname.coursepick.length; i++) {
@@ -1546,8 +1553,7 @@ sub course_select_row {
            $output .= '</tr></table><br />';
        }
    }
 -    $output .= '<input type="radio" name="coursepick" value="specific" 
onclick="coursePick(this.form);opencrsbrowser('."'".$formname."'".','."'".'d 
ccourse'."'".','."'".'dcdomain'."'".','."'".'coursedesc'."','','1'".')" 
/>'.&mt('Pick specific course(s):').' '.$courseform.'&nbsp;&nbsp;<input 
type="text" value="0" size="4" name="coursetotal" /><input type="hidden" 
name="courselist" value="" />selected.<br />'."\n";
 -    $output .= &row_closure();
+    $output .= '<input type="radio" name="coursepick" value="specific" 
onclick="coursePick(this.form);opencrsbrowser('."'".$formname."','dccourse', 
'dcdomain','coursedesc','','1'".')" />'.&mt('Pick specific course(s):').' 
'.$courseform.'&nbsp;&nbsp;<input type="text" value="0" size="4" 
name="coursetotal" /><input type="hidden" name="courselist" value="" 
/>selected.<br />'."\n";
    return $output;
} 

 --- loncom/interface/loncoursedata.pm	2007/10/03 18:22:50	1.183
+++ loncom/interface/loncoursedata.pm	2007/11/06 04:39:19	1.184
@@ -1,6 +1,6 @@
# The LearningOnline Network with CAPA
#
 -# $Id: loncoursedata.pm,v 1.183 2007/10/03 18:22:50 banghart Exp $
+# $Id: loncoursedata.pm,v 1.184 2007/11/06 04:39:19 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -3100,6 +3100,9 @@ sub CL_STATUS   { return 7; }
sub CL_TYPE     { return 8; }
sub CL_LOCKEDTYPE   { return 9; }
sub CL_GROUP    { return 10; }
+sub CL_PERMANENTEMAIL { return 11; }
+sub CL_ROLE     { return 12; }
+sub CL_EXTENT   { return 13; } 

sub get_classlist {
    my ($cdom,$cnum) = @_; 

 --- loncom/interface/loncreateuser.pm	2007/10/22 22:16:38	1.190
+++ loncom/interface/loncreateuser.pm	2007/11/06 04:39:19	1.191
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Create a user
#
 -# $Id: loncreateuser.pm,v 1.190 2007/10/22 22:16:38 raeburn Exp $
+# $Id: loncreateuser.pm,v 1.191 2007/11/06 04:39:19 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -835,14 +835,14 @@ ENDAUTH
ENDPORT
    } else { # user already exists
	my %lt=&Apache::lonlocal::texthash(
 -                    'cup'  => "Existing user ",
+                    'cup'  => "Modify existing user: ",
                    'id'   => "in domain",
				       );
	$r->print(<<ENDCHANGEUSER);
$start_page
$crumbs
$forminfo
 -<h3>$lt{'cup'} "$ccuname" $lt{'id'} "$ccdomain"</h3>
+<h2>$lt{'cup'} "$ccuname" $lt{'id'} "$ccdomain"</h2>
ENDCHANGEUSER
        $r->print('<div class="LC_left_float">'.
                  &personal_data_display($ccuname,$ccdomain,$newuser,
@@ -886,7 +886,7 @@ ENDNOPORTPRIV
        unless ($tmp =~ /^(con_lost|error)/i) {
           my $now=time;
	   my %lt=&Apache::lonlocal::texthash(
 -		    'rer'  => "Revoke Existing Roles",
+		    'rer'  => "Existing Roles",
                    'rev'  => "Revoke",
                    'del'  => "Delete",
		    'ren'  => "Re-Enable",
@@ -2489,21 +2489,30 @@ sub handler {
            &custom_role_editor($r);
        }
    } elsif ($env{'form.action'} eq 'listusers' && $permission->{'view'}) {
 -        $r->print(&header());
+        my 
($cb_jscript,$jscript,$totcodes,$codetitles,$idlist,$idlist_titles);
+        my $formname = 'studentform';
+        if ($context eq 'domain' && $env{'form.roletype'} eq 'course') {
+            
($cb_jscript,$jscript,$totcodes,$codetitles,$idlist,$idlist_titles) =
+                
&Apache::lonuserutils::courses_selector($env{'request.role.domain'},
+                                                        $formname);
+            my $js = &add_script($jscript).$cb_jscript;
+            my $loadcode =
+                &Apache::lonuserutils::course_selector_loadcode($formname);
+            if ($loadcode ne '') {
+                $r->print(&header($js,{'onload' => $loadcode,}));
+            } else {
+                $r->print(&header($js));
+            }
+        } else {
+            $r->print(&header());
+        }
        &Apache::lonhtmlcommon::add_breadcrumb
            ({href=>'/adm/createuser?action=listusers',
 -              text=>"List Users' Roles"});
 -        $r->print(&Apache::lonhtmlcommon::breadcrumbs("List Users' Roles",
+              text=>"List Users"});
+        $r->print(&Apache::lonhtmlcommon::breadcrumbs("List Users",
                                                      
'User_Management_List'));
 -        if (! exists($env{'form.state'})) {
 -            
&Apache::lonuserutils::print_html_classlist($r,undef,$permission);
 -        } elsif ($env{'form.state'} eq 'csv') {
 -            
&Apache::lonuserutils::print_html_classlist($r,'csv',$permission);
 -        } elsif ($env{'form.state'} eq 'excel') {
 -            
&Apache::lonuserutils::print_html_classlist($r,'excel',$permission);
 -        } else {
 -            
&Apache::lonuserutils::print_html_classlist($r,undef,$permission);
 -        }
+        
&Apache::lonuserutils::print_userlist($r,undef,$permission,$context,
+                     
$formname,$totcodes,$codetitles,$idlist,$idlist_titles);
        $r->print(&Apache::loncommon::end_page());
    } elsif ($env{'form.action'} eq 'expire' && $permission->{'cusr'}) {
        $r->print(&header());
@@ -2539,6 +2548,11 @@ sub header {
    return $start_page;
} 

+sub add_script {
+    my ($js) = @_;
+    return '<script type="text/javascript">'."\n".$js."\n".'</script>';
+}
+
###############################################################
###############################################################
#  Menu Phase One
@@ -2546,22 +2560,22 @@ sub print_main_menu {
    my ($permission) = @_;
    my @menu =
        (
 -          { text => 'Upload a File of Users to Set Roles',
+          { text => 'Upload a File of Users to Modify/Create Users and/or 
Add roles',
            help => 'User_Management_Upload',
            action => 'upload',
            permission => $permission->{'cusr'},
            },
 -          { text => 'Set User Roles for an Individual User',
+          { text => 'Create User/Set User Roles for a single user',
            help => 'User_Management_Single_User',
            action => 'singleuser',
            permission => $permission->{'cusr'},
            },
 -#          { text => 'Display User Roles for Multiple Users',
 -#            help => 'User_Management_List',
 -#            action => 'listusers',
 -#            permission => $permission->{'view'},
 -#            },
 -#          { text => 'Expire User Roles ',
+          { text => 'Display Lists of Users',
+            help => 'User_Management_List',
+            action => 'listusers',
+            permission => $permission->{'view'},
+            },
+#          { text => 'Expire User Roles',
#            help => 'User_Management_Drops',
#            action => 'expire',
#            permission => $permission->{'cusr'}, 

 --- loncom/interface/lonpickcourse.pm	2007/10/22 22:16:38	1.66
+++ loncom/interface/lonpickcourse.pm	2007/11/06 04:39:19	1.67
@@ -1,7 +1,7 @@
# The LearningOnline Network
# Pick a course
#
 -# $Id: lonpickcourse.pm,v 1.66 2007/10/22 22:16:38 raeburn Exp $
+# $Id: lonpickcourse.pm,v 1.67 2007/11/06 04:39:19 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -93,7 +93,8 @@ sub handler { 

    if ($env{'form.form'} eq 'portform') {
        $lastaction = 'document.courselist.submit()';
 -    } elsif ($env{'form.form'} eq 'cu' || $env{'form.form'} eq 
'studentform') {
+    } elsif ($env{'form.form'} eq 'cu' || ($env{'form.form'} eq 
'studentform' &&
+        !$multiple)) {
        $lastaction =
             'document.courselist.pickedcourse.value = 
cdom+"_"+cname;'."\n".
             'document.courselist.submit();';
@@ -347,7 +348,10 @@ sub build_filters {
	    if ($formname eq 'portform') {
		$filter->{$item} ||= $env{'user.domain'};
		$allow_blank=0;
 -	    }
+	    } elsif ($formname eq 'studentform') {
+                $filter->{$item} ||= $env{'request.role.domain'};
+                $allow_blank=0;
+            }
            $domainselectform =
		&Apache::loncommon::select_dom_form($filter->{$item},
						    'domainfilter',