|
-$titleinfo $dc_info
+$titleinfo $dc_info $menu
|
$env{'environment.firstname'}
@@ -2915,7 +2960,7 @@ ENDBODY
=back
-=head1 HTTP Helpers
+=head1 HTML Helpers
=over 4
@@ -2923,26 +2968,268 @@ ENDBODY
Returns a uniform footer for LON-CAPA web pages.
-Inputs:
-
-=over 4
+Inputs: none
=back
-Returns: A uniform footer for LON-CAPA web pages.
-
=cut
sub endbodytag {
my $endbodytag='';
$endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
+ if ( exists( $env{'internal.head.redirect'} ) ) {
+ $endbodytag=
+ "
".
+ &mt('Continue').''.
+ $endbodytag;
+ }
return $endbodytag;
}
+=pod
+
+=over 4
+
+=item * &headtag()
+
+Returns a uniform footer for LON-CAPA web pages.
+
+Inputs: $title - optional title for the head
+ $head_extra - optional extra HTML to put inside the
+ $args - optional arguments
+ force_register - if is true call registerurl so the remote is
+ informed
+
+ redirect - array ref of seconds before redirect occurs
+ url to redirect to
+ (side effect of setting
+ $env{'internal.head.redirect'} to the url
+ redirected too)
+=back
+
+=cut
+
+sub headtag {
+ my ($title,$head_extra,$args) = @_;
+
+ my $result =
+ ''.
+ &Apache::lonxml::fontsettings().
+ &Apache::lonhtmlcommon::htmlareaheaders();
+
+ if ($args->{'force_register'}) {
+ $result .= &Apache::lonmenu::registerurl(1);
+ }
+
+ if (ref($args->{'redirect'})) {
+ my ($time,$url) = @{$args->{'redirect'}};
+ $url = &Apache::lonenc::check_encrypt($url);
+ $env{'internal.head.redirect'} = $url;
+ $result.=<
+
+ADDMETA
+ }
+ if (!defined($title)) {
+ $title = 'The LearningOnline Network with CAPA';
+ }
+
+ $result .= ' LON-CAPA '.&mt($title).''.$head_extra;
+ return $result;
+}
+
+=pod
+
+=over 4
+
+=item * &endheadtag()
+
+Returns a uniform for LON-CAPA web pages.
+
+Inputs: none
+
+=back
+
+=cut
+
+sub endheadtag {
+ return '';
+}
+
+=pod
+
+=over 4
+
+=item * &head()
+
+Returns a uniform complete .. section for LON-CAPA web pages.
+
+Inputs: $title - optional title for the page
+ $head_extra - optional extra HTML to put inside the
+=back
+
+=cut
+
+sub head {
+ my ($title,$head_extra,$args) = @_;
+ return &headtag($title,$head_extra,$args).&endheadtag();
+}
+
+=pod
+
+=over 4
+
+=item * &start_page()
+
+Returns a complete .. section for LON-CAPA web pages.
+
+Inputs: $title - optional title for the page
+ $head_extra - optional extra HTML to incude inside the
+ $args - additional optional args supported are:
+ only_body -> is true will set &bodytag() onlybodytag
+ arg on
+ no_nav_bar -> is true will set &bodytag() notopbar arg on
+ add_entries -> additional attributes to add to the
+ domain -> force to color decorate a page for a
+ specific domain
+ function -> force usage of a specific rolish color
+ scheme
+ redirect -> see &headtag()
+ bgcolor -> override the default page bg color
+ js_ready -> return a string ready for being used in
+ a javascript writeln
+ html_encode -> return a string ready for being used in
+ a html attribute
+ force_register -> if is true will turn on the &bodytag()
+ $forcereg arg
+ body_title -> alternate text to use instead of $title
+ in the title box that appears, this text
+ is not auto translated like the $title is
+
+=back
+
+=cut
+
+sub start_page {
+ my ($title,$head_extra,$args) = @_;
+ #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
+ my %head_args;
+ foreach my $arg ('redirect','force_register') {
+ if (defined($args->{$arg})) {
+ $head_args{$arg} = $args->{$arg};
+ }
+ }
+
+ $env{'internal.start_page'}++;
+ my $result =
+ &Apache::lonxml::xmlbegin().
+ &headtag($title,$head_extra,\%head_args).&endheadtag().
+ &bodytag($title,
+ $args->{'function'}, $args->{'add_entries'},
+ $args->{'only_body'}, $args->{'domain'},
+ $args->{'force_register'}, $args->{'body_title'},
+ $args->{'no_nav_bar'}, $args->{'bgcolor'});
+ if ($args->{'js_ready'}) {
+ $result = &js_ready($result);
+ }
+ if ($args->{'html_encode'}) {
+ $result = &html_encode($result);
+ }
+ return $result;
+}
+
+=pod
+
+=over 4
+
+=item * &head()
+
+Returns a complete section for LON-CAPA web pages.
+
+Inputs: $args - additional optional args supported are:
+ js_ready -> return a string ready for being used in
+ a javascript writeln
+ html_encode -> return a string ready for being used in
+ a html attribute
+=back
+
+=cut
+
+sub end_page {
+ my ($args) = @_;
+ #&Apache::lonnet::logthis("end_page ".join(':',caller(0)));
+ $env{'internal.end_page'}++;
+ my $result = &endbodytag()."\n";
+ if ($args->{'js_ready'}) {
+ $result = &js_ready($result);
+ }
+ if ($args->{'html_encode'}) {
+ $result = &html_encode($result);
+ }
+ return $result;
+}
+
+sub html_encode {
+ my ($result) = @_;
+
+ $result = &HTML::Entities::encode($result,'<>&"');
+
+ return $result;
+}
+sub js_ready {
+ my ($result) = @_;
+
+ $result =~ s/[\n\r]/ /xmsg;
+ $result =~ s/\\/\\\\/xmsg;
+ $result =~ s/'/\\'/xmsg;
+ $result =~ s{}{}xmsg;
+
+ return $result;
+}
+
+sub validate_page {
+ if ( exists($env{'internal.start_page'})
+ && $env{'internal.start_page'} > 1) {
+ &Apache::lonnet::logthis('start_page called multiple times '.
+ $env{'internal.start_page'}.' '.
+ $ENV{'request.filename'});
+ }
+ if ( exists($env{'internal.end_page'})
+ && $env{'internal.end_page'} > 1) {
+ &Apache::lonnet::logthis('end_page called multiple times '.
+ $env{'internal.end_page'}.' '.
+ $env{'request.filename'});
+ }
+ if ( exists($env{'internal.start_page'})
+ && ! exists($env{'internal.end_page'})) {
+ &Apache::lonnet::logthis('start_page called without end_page '.
+ $env{'request.filename'});
+ }
+ if ( ! exists($env{'internal.start_page'})
+ && exists($env{'internal.end_page'})) {
+ &Apache::lonnet::logthis('end_page called without start_page'.
+ $env{'request.filename'});
+ }
+}
+
+sub simple_error_page {
+ my ($r,$title,$msg) = @_;
+ my $page =
+ &Apache::loncommon::start_page($title).
+ &mt($msg).
+ &Apache::loncommon::end_page();
+ if (ref($r)) {
+ $r->print($page);
+ return;
+ }
+ return $page;
+}
###############################################
=pod
+=over 4
+
=item get_users_function
Used by &bodytag to determine the current users primary role.
@@ -3076,6 +3363,153 @@ 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
+whether 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 $role = '';
+ my %content=();
+ while ($token=$parser->get_token) {
+ if ($token->[0] eq 'S') {
+ my $entry=$token->[1];
+ if ($entry eq 'functions' || $entry eq 'autosec') {
+ %{$content{$entry}} = ();
+ $tool = $entry;
+ } elsif ($entry eq 'role') {
+ if ($tool eq 'autosec') {
+ $role = $token->[2]{id};
+ }
+ } 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);
+ } elsif (($entry eq 'roles') || ($entry eq 'types') ||
+ ($entry eq 'sectionpick') || ($entry eq 'defpriv')) {
+ push(@{$content{$entry}},$value);
+ } elsif ($entry eq 'section') {
+ if ($tool eq 'autosec' && $role ne '') {
+ push(@{$content{$tool}{$role}},$value);
+ }
+ } else {
+ $content{$entry}=$value;
+ }
+ }
+ } elsif ($token->[0] eq 'E') {
+ if ($token->[1] eq 'functions' || $token->[1] eq 'autosec') {
+ $tool = '';
+ } elsif ($token->[1] eq 'role') {
+ $role = '';
+ }
+
+ }
+ }
+ 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
@@ -3090,64 +3524,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);
+ }
}
}
}
@@ -3155,7 +3633,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;
+}
###############################################
@@ -3223,8 +3708,22 @@ sub get_posted_cgi {
}
}
}
+#
+# Digested POSTed values
+#
+# Remember the way this was originally done (GET or POST)
+#
$env{'request.method'}=$ENV{'REQUEST_METHOD'};
- $r->method_number(M_GET);
+#
+# There may also be stuff in the query string
+# Tell subsequent handlers that this was GET, not POST, so they can access query string.
+# Also, unset POSTed content length to cover all tracks.
+#
+
+# This does not work, because M_GET is not defined (if it's defined, it is just 0).
+# Commenting out for now ... not sure if harm is done.
+# $r->method_number(M_GET);
+
$r->method('GET');
$r->headers_in->unset('Content-length');
}
@@ -3295,6 +3794,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;
@@ -3529,6 +4032,22 @@ sub upfile_select_html {
return $Str;
}
+sub get_samples {
+ my ($records,$toget) = @_;
+ my @samples=({});
+ my $got=0;
+ foreach my $rec (@$records) {
+ my %temp = &record_sep($rec);
+ if (! grep(/\S/, values(%temp))) { next; }
+ if (%temp) {
+ $samples[$got]=\%temp;
+ $got++;
+ if ($got == $toget) { last; }
+ }
+ }
+ return \@samples;
+}
+
######################################################
######################################################
@@ -3546,18 +4065,15 @@ Apache Request ref, $records is an array
######################################################
sub csv_print_samples {
my ($r,$records) = @_;
- my (%sone,%stwo,%sthree);
- %sone=&record_sep($$records[0]);
- if (defined($$records[1])) {%stwo=&record_sep($$records[1]);}
- if (defined($$records[2])) {%sthree=&record_sep($$records[2]);}
- #
+ my $samples = &get_samples($records,3);
+
$r->print(&mt('Samples').'
');
- foreach (sort({$a <=> $b} keys(%sone))) {
+ foreach (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
$r->print('| '.&mt('Column [_1]',($_+1)).' | '); }
$r->print(' ');
- foreach my $hash (\%sone,\%stwo,\%sthree) {
+ foreach my $hash (@$samples) {
$r->print('');
- foreach (sort({$a <=> $b} keys(%sone))) {
+ foreach (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
$r->print('| ');
if (defined($$hash{$_})) { $r->print($$hash{$_}); }
$r->print(' | ');
@@ -3586,8 +4102,8 @@ $d is an array of 2 element arrays (inte
######################################################
sub csv_print_select_table {
my ($r,$records,$d) = @_;
- my $i=0;my %sone;
- %sone=&record_sep($$records[0]);
+ my $i=0;
+ my $samples = &get_samples($records,1);
$r->print(&mt('Associate columns with student attributes.')."\n".
''.
'| '.&mt('Attribute').' | '.
@@ -3599,7 +4115,7 @@ sub csv_print_select_table {
$r->print(' |
|