[LON-CAPA-cvs] cvs: loncom /interface londropadd.pm
matthew
lon-capa-cvs@mail.lon-capa.org
Tue, 15 Oct 2002 14:41:31 -0000
This is a MIME encoded message
--matthew1034692891
Content-Type: text/plain
matthew Tue Oct 15 10:41:31 2002 EDT
Modified files:
/loncom/interface londropadd.pm
Log:
Modifications to use &Apache::loncoursedata::get_classlist().
Removed londropadd::get_current_classlist.
Modified other routines to use get_classlist
Added code to remove heading and trailing whitespace for data in csv uploads.
Removed &drop_students because it was neven used and called a function that
did not exist.
Occasional POD & comment updates.
--matthew1034692891
Content-Type: text/plain
Content-Disposition: attachment; filename="matthew-20021015104131.txt"
Index: loncom/interface/londropadd.pm
diff -u loncom/interface/londropadd.pm:1.55 loncom/interface/londropadd.pm:1.56
--- loncom/interface/londropadd.pm:1.55 Thu Sep 26 10:04:34 2002
+++ loncom/interface/londropadd.pm Tue Oct 15 10:41:31 2002
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Handler to drop and add students in courses
#
-# $Id: londropadd.pm,v 1.55 2002/09/26 14:04:34 matthew Exp $
+# $Id: londropadd.pm,v 1.56 2002/10/15 14:41:31 matthew Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -734,34 +734,18 @@
return;
}
-# =================================================== get the current classlist
-sub get_current_classlist {
- my $r = shift;
- # Call DownloadClasslist
- my $cid = $ENV{'request.course.id'};
- my $c = $r->connection;
- my $classlisthash = &Apache::loncoursedata::DownloadClasslist
- ($cid,'Not downloaded',$c);
- # Call ProcessClasslist
- my %cache;
- my @students = &Apache::loncoursedata::ProcessClasslist(\%cache,
- $classlisthash,
- $cid,$c);
- return (\@students,\%cache);
-}
-
# ========================================================= Menu Phase Two Drop
sub print_drop_menu {
my $r=shift;
$r->print("<h3>Drop Students</h3>");
my $cid=$ENV{'request.course.id'};
- my ($student_array,$student_data)=&get_current_classlist($r);
- if (! scalar(@$student_array)) {
+ my ($classlist,$keylist) = &Apache::loncoursedata::get_classlist();
+ if (! defined($classlist)) {
$r->print("There are no students currently enrolled.\n");
return;
}
# Print out the available choices
- &show_drop_list($student_array,$student_data,$r);
+ &show_drop_list($r,$classlist,$keylist);
return;
}
@@ -775,17 +759,17 @@
</p>
END
my $cid=$ENV{'request.course.id'};
- my ($student_array,$student_data)=&get_current_classlist($r);
- if (! scalar(@$student_array)) {
+ my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist();
+ if (! defined($classlist)) {
$r->print("There are no students currently enrolled.\n");
} else {
# Print out the available choices
if ($ENV{'form.action'} eq 'modifystudent') {
&show_class_list($r,'view','modify','modifystudent',
- 'any',$student_array,$student_data);
+ 'Active',$classlist,$keylist);
} else {
&show_class_list($r,'view','aboutme','classlist',
- 'any',$student_array,$student_data);
+ 'Active',$classlist,$keylist);
}
}
}
@@ -794,18 +778,18 @@
sub print_csv_classlist {
my $r=shift;
my $cid=$ENV{'request.course.id'};
- my ($student_array,$student_data)=&get_current_classlist($r);
- if (! scalar(@$student_array)) {
+ my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist();
+ if (! defined($classlist)) {
$r->print("There are no students currently enrolled.\n");
} else {
&show_class_list($r,'csv','nolink','csv',
- 'any',$student_array,$student_data);
+ 'Active',$classlist,$keylist);
}
}
# =================================================== Show student list to drop
sub show_class_list {
- my ($r,$mode,$linkto,$action,$statusmode,$students,$s_data)=@_;
+ my ($r,$mode,$linkto,$action,$statusmode,$classlist,$keylist)=@_;
my $cid=$ENV{'request.course.id'};
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
['sortby']);
@@ -816,7 +800,7 @@
# Print out header
if ($mode eq 'view') {
if ($linkto eq 'aboutme') {
- $r->print('Select a user name to view the users page.');
+ $r->print('Select a user name to view the users personal page.');
} elsif ($linkto eq 'modify') {
$r->print('Select a user name to modify the students information');
}
@@ -841,32 +825,30 @@
$r->print('"'.join('","',("username","domain","ID","student name",
"section")).'"'."\n");
}
+ #
+ # Sort the students
+ my %index;
+ my $i;
+ foreach (@$keylist) {
+ $index{$_} = $i++;
+ }
+ my $index = $index{$sortby};
+ my $second = $index{'username'};
+ my $third = $index{'domain'};
my @Sorted_Students = sort {
- lc($s_data->{$a.':'.$sortby}) cmp lc($s_data->{$b.':'.$sortby})
- ||
- lc($s_data->{$a.':username'}) cmp lc($s_data->{$b.':username'})
- ||
- lc($s_data->{$a.':domain'}) cmp lc($s_data->{$b.':domain'})
- } @$students;
+ lc($classlist->{$a}->[$index]) cmp lc($classlist->{$b}->[$index])
+ ||
+ lc($classlist->{$a}->[$second]) cmp lc($classlist->{$b}->[$second])
+ ||
+ lc($classlist->{$a}->[$third]) cmp lc($classlist->{$b}->[$third])
+ } (keys(%$classlist));
foreach my $student (@Sorted_Students) {
- my $error;
- if (exists($s_data->{$student.':error'})) {
- $error = $s_data->{$student.':error'};
- }
- if ($error) {
- $r->print('<tr><td colspan="6">'.
- '<font color="#FF8888">Error</font>'.
- 'Error retrieving data for '.
- join('@',split(/:/,$student)).
- ', '.$error.'</td></tr>'."\n");
- next;
- }
- my $username = $s_data->{$student.':username'};
- my $domain = $s_data->{$student.':domain'};
- my $section = $s_data->{$student.':section'};
- my $name = $s_data->{$student.':fullname'};
- my $status = $s_data->{$student.':Status'};
- my $id = $s_data->{$student.':id'};
+ my $username = $classlist->{$student}->[$index{'username'}];
+ my $domain = $classlist->{$student}->[$index{'domain'}];
+ my $section = $classlist->{$student}->[$index{'section'}];
+ my $name = $classlist->{$student}->[$index{'fullname'}];
+ my $id = $classlist->{$student}->[$index{'id'}];
+ my $status = $classlist->{$student}->[$index{'status'}];
next if (($statusmode ne 'any') && ($status ne $statusmode));
if ($mode eq 'view') {
$r->print("<tr>\n <td>\n ");
@@ -1136,9 +1118,35 @@
return ($start,$end,$section);
}
-# =================================================== Show student list to drop
+#################################################
+#################################################
+
+=pod
+
+=item show_drop_list
+
+Display a list of students to drop
+Inputs:
+
+=over 4
+
+=item $r, Apache request
+
+=item $classlist, hash pointer returned from loncoursedata::get_classlist();
+
+=item $keylist, array pointer returned from loncoursedata::get_classlist()
+which describes the order elements are stored in the %$classlist values.
+
+=item $nosort, if true, sorting links are omitted.
+
+=back
+
+=cut
+
+#################################################
+#################################################
sub show_drop_list {
- my ($students,$s_data,$r)=@_;
+ my ($r,$classlist,$keylist,$nosort)=@_;
my $cid=$ENV{'request.course.id'};
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
['sortby']);
@@ -1146,6 +1154,7 @@
if ($sortby !~ /^(username|domain|section|fullname|id)$/) {
$sortby = 'username';
}
+ #
my $action = "drop";
$r->print(<<END);
<input type="hidden" name="sortby" value="$sortby" />
@@ -1164,6 +1173,23 @@
</script>
<p>
<input type="hidden" name="phase" value="four">
+END
+
+ if ($nosort) {
+ $r->print(<<END);
+<table border=2>
+<tr>
+ <th> </th>
+ <th>username</th>
+ <th>domain</th>
+ <th>ID</th>
+ <th>student name</th>
+ <th>section</th>
+</tr>
+END
+
+ } else {
+ $r->print(<<END);
<table border=2>
<tr><th> </th>
<th>
@@ -1179,32 +1205,32 @@
</th>
</tr>
END
+ }
+ #
+ # Sort the students
+ my %index;
+ my $i;
+ foreach (@$keylist) {
+ $index{$_} = $i++;
+ }
+ my $index = $index{$sortby};
+ my $second = $index{'username'};
+ my $third = $index{'domain'};
my @Sorted_Students = sort {
- lc($s_data->{$a.':'.$sortby}) cmp lc($s_data->{$b.':'.$sortby})
- ||
- lc($s_data->{$a.':username'}) cmp lc($s_data->{$b.':username'})
- ||
- lc($s_data->{$a.':domain'}) cmp lc($s_data->{$b.':domain'})
- } @$students;
+ lc($classlist->{$a}->[$index]) cmp lc($classlist->{$b}->[$index])
+ ||
+ lc($classlist->{$a}->[$second]) cmp lc($classlist->{$b}->[$second])
+ ||
+ lc($classlist->{$a}->[$third]) cmp lc($classlist->{$b}->[$third])
+ } (keys(%$classlist));
foreach my $student (@Sorted_Students) {
my $error;
- if (exists($s_data->{$student.':error'})) {
- $error = $s_data->{$student.':error'};
- }
- if ($error) {
- $r->print('<tr><td colspan="6">'.
- '<font color="#FF8888">Error</font>'.
- 'Error retrieving data for '.
- join('@',split(/:/,$student)).
- ', '.$error.'</td></tr>'."\n");
- next;
- }
- my $username = $s_data->{$student.':username'};
- my $domain = $s_data->{$student.':domain'};
- my $section = $s_data->{$student.':section'};
- my $name = $s_data->{$student.':fullname'};
- my $status = $s_data->{$student.':Status'};
- my $id = $s_data->{$student.':id'};
+ my $username = $classlist->{$student}->[$index{'username'}];
+ my $domain = $classlist->{$student}->[$index{'domain'}];
+ my $section = $classlist->{$student}->[$index{'section'}];
+ my $name = $classlist->{$student}->[$index{'fullname'}];
+ my $id = $classlist->{$student}->[$index{'id'}];
+ my $status = $classlist->{$student}->[$index{'status'}];
next if ($status ne 'Active');
#
$r->print(<<"END");
@@ -1373,6 +1399,11 @@
}
}
}
+ # Clean up whitespace
+ foreach (\$domain,\$username,\$id,\$fname,\$mname,
+ \$lname,\$gen,\$sec) {
+ $$_ =~ s/(\s+$|^\s+)//g;
+ }
if ($password) {
&modifystudent($domain,$username,$cid,$sec,
$desiredhost);
@@ -1408,66 +1439,26 @@
if ($ENV{'form.fullup'} eq 'yes') {
$r->print('<h3>Dropping Students</h3>');
# Get current classlist
- my ($error,%currentlist)=&get_current_classlist($r);
- if (defined($error)) {
- $r->print('<pre>ERROR:$error</pre>');
- }
- if (defined(%currentlist)) {
- # Drop the students
+ my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist();
+ if (! defined($classlist)) {
+ $r->print("There are no students currently enrolled.\n");
+ } else {
+ # Remove the students we just added from the list of students.
foreach (@studentdata) {
my %entries=&Apache::loncommon::record_sep($_);
unless (($entries{$fields{'username'}} eq '') ||
(!defined($entries{$fields{'username'}}))) {
- delete($currentlist{$entries{$fields{'username'}}.
+ delete($classlist->{$entries{$fields{'username'}}.
':'.$domain});
}
}
- # Print out list of dropped students
- &show_drop_list($r,%currentlist);
- } else {
- $r->print("There are no students currently enrolled.\n");
+ # Print out list of dropped students.
+ &show_drop_list($r,$classlist,$keylist,'nosort');
}
}
} # end of unless
}
-###################################################################
-###################################################################
-
-=pod
-
-=item &drop_students
-
-Inputs: \@droplist, a pointer to an array of students to drop.
-Students should be in format of studentname:studentdomain
-
-Returns: $errors, a string describing any errors encountered.
-$successes, a string describing the successful dropping of students.
-
-=cut
-
-###################################################################
-###################################################################
-sub drop_students {
- my @droplist = @{shift()};
- my $courseid = $ENV{'request.course.id'};
- my $successes = '';
- my $errors = '';
- foreach (@droplist) {
- my ($sname,$sdom)=split(/:/,$_);
- my $result = &drop_student($sname,$sdom,$courseid);
- if ($result !~ /ok/) {
- $errors .= "Error dropping $sname\@$sdom: $result\n";
- } else {
- $successes .= "Dropped $sname\@$sdom\n";
- }
- }
- return ($errors,$successes);
-}
-###################################################################
-###################################################################
-
-
# ================================================================== Phase four
sub drop_student_list {
my $r=shift;
@@ -1480,6 +1471,7 @@
}
foreach (@droplist) {
my ($uname,$udom)=split(/\:/,$_);
+ # drop student
my $result = &modifystudent($udom,$uname,$ENV{'request.course.id'});
if ($result eq 'ok' || $result eq 'ok:') {
$r->print('Dropped '.$uname.' @ '.$udom.'<br>');
--matthew1034692891--