--- loncom/interface/loncommon.pm 2005/12/01 23:04:08 1.300
+++ loncom/interface/loncommon.pm 2006/03/23 23:43:13 1.320
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.300 2005/12/01 23:04:08 albertel Exp $
+# $Id: loncommon.pm,v 1.320 2006/03/23 23:43:13 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -331,7 +331,10 @@ sub storeresurl {
sub studentbrowser_javascript {
unless (
(($env{'request.course.id'}) &&
- (&Apache::lonnet::allowed('srm',$env{'request.course.id'})))
+ (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
+ || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
+ '/'.$env{'request.course.sec'})
+ ))
|| ($env{'request.role'}=~/^(au|dc|su)/)
) { return ''; }
return (<<'ENDSTDBRW');
@@ -362,7 +365,9 @@ ENDSTDBRW
sub selectstudent_link {
my ($form,$unameele,$udomele)=@_;
if ($env{'request.course.id'}) {
- unless (&Apache::lonnet::allowed('srm',$env{'request.course.id'})) {
+ if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
+ && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
+ '/'.$env{'request.course.sec'})) {
return '';
}
return "<a href='".'javascript:openstdbrowser("'.$form.'","'.$unameele.
@@ -2732,6 +2737,13 @@ Inputs:
=item * $forcereg, if page should register as content page (relevant for
text interface only)
+=item * $customtitle, overrides the $title in some way ????
+
+=item * $notopbar, if true, keep the 'what is this' info but remove the
+ navigational links
+
+=item * $bgcolor, used to override the bg coor on a webpage to a specific value
+
=back
Returns: A uniform header for LON-CAPA web pages.
@@ -2742,11 +2754,12 @@ other decorations will be returned.
=cut
sub bodytag {
- my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,$customtitle,$notopbar)=@_;
+ my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,$customtitle,
+ $notopbar,$bgcolor)=@_;
$title=&mt($title);
$function = &get_users_function() if (!$function);
my $img=&designparm($function.'.img',$domain);
- my $pgbg=&designparm($function.'.pgbg',$domain);
+ my $pgbg= $bgcolor || &designparm($function.'.pgbg',$domain);
my $tabbg=&designparm($function.'.tabbg',$domain);
my $font=&designparm($function.'.font',$domain);
my $link=&designparm($function.'.link',$domain);
@@ -2782,6 +2795,7 @@ table.thinborder { border-collapse: coll
table.thinborder tr th, table.thinborder tr td { border-style: solid; border-width: 1px}
form, .inline { display: inline; }
.center { text-align: center; }
+.filename {font-family: monospace;}
</style>
<body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link"
style="margin-top: 0px;$addstyle" $addentries>
@@ -2887,6 +2901,8 @@ ENDROLE
$dc_info.= $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
$dc_info = '('.$dc_info.')';
}
+ # Explicit link to get inline menu
+ my $menu='<br /><font size="2" face="Arial, Helvetica, sans-serif"> <a href="/adm/remote?action=collapse">'.&mt('Switch to Inline Menu Mode').'</a></font>';
#
return(<<ENDBODY);
$bodytag
@@ -2897,7 +2913,7 @@ $upperleft</td>
</tr>
<tr>
<td rowspan="3" bgcolor="$tabbg">
-$titleinfo $dc_info
+$titleinfo $dc_info $menu
</td><td bgcolor="$tabbg" align="right">
<font size="2" face="Arial, Helvetica, sans-serif">
$env{'environment.firstname'}
@@ -2923,7 +2939,7 @@ ENDBODY
=back
-=head1 HTTP Helpers
+=head1 HTML Helpers
=over 4
@@ -2931,26 +2947,264 @@ 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='</body>';
$endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
+ if ( exists( $env{'internal.head.redirect'} ) ) {
+ $endbodytag=
+ "<br /><a href=\"$env{'internal.head.redirect'}\">".
+ &mt('Continue').'</a>'.
+ $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 <head>
+ $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 =
+ '<head>'.
+ &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
+<meta http-equiv="pragma" content="no-cache" />
+<meta HTTP-EQUIV="Refresh" CONTENT="2; url=$url" />
+ADDMETA
+ }
+ if (!defined($title)) {
+ $title = 'The LearningOnline Network with CAPA';
+ }
+
+ $result .= '<title> LON-CAPA '.&mt($title).'</title>'.$head_extra;
+
+ return $result;
+}
+
+=pod
+
+=over 4
+
+=item * &endheadtag()
+
+Returns a uniform </head> for LON-CAPA web pages.
+
+Inputs: none
+
+=back
+
+=cut
+
+sub endheadtag {
+ return '</head>';
+}
+
+=pod
+
+=over 4
+
+=item * &head()
+
+Returns a uniform complete <head>..</head> section for LON-CAPA web pages.
+
+Inputs: $title - optional title for the page
+ $head_extra - optional extra HTML to put inside the <head>
+=back
+
+=cut
+
+sub head {
+ my ($title,$head_extra) = @_;
+ return &headtag($title,$head_extra).&endheadtag();
+}
+
+=pod
+
+=over 4
+
+=item * &start_page()
+
+Returns a complete <html> .. <body> section for LON-CAPA web pages.
+
+Inputs: $title - optional title for the page
+ $head_extra - optional extra HTML to incude inside the <head>
+ $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 <body>
+ 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
+
+=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->{$args};
+ }
+ }
+
+ $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'}, undef,
+ $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 </body></html> 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</html>";
+ 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]/ /g;
+ $result =~ s/'/\\'/g;
+
+ 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 OK;
+ }
+ return $page;
+}
###############################################
=pod
+=over 4
+
=item get_users_function
Used by &bodytag to determine the current users primary role.
@@ -3165,7 +3419,7 @@ times for group members.
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.
+whether this type of functionality is available for the group.
=cut
@@ -3176,13 +3430,18 @@ sub get_group_settings {
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') {
+ 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') {
@@ -3192,14 +3451,24 @@ sub get_group_settings {
}
} 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') {
+ if ($token->[1] eq 'functions' || $token->[1] eq 'autosec') {
$tool = '';
+ } elsif ($token->[1] eq 'role') {
+ $role = '';
}
+
}
}
return %content;
@@ -3724,6 +3993,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;
+}
+
######################################################
######################################################
@@ -3741,18 +4026,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').'<br /><table border="2"><tr>');
- foreach (sort({$a <=> $b} keys(%sone))) {
+ foreach (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
$r->print('<th>'.&mt('Column [_1]',($_+1)).'</th>'); }
$r->print('</tr>');
- foreach my $hash (\%sone,\%stwo,\%sthree) {
+ foreach my $hash (@$samples) {
$r->print('<tr>');
- foreach (sort({$a <=> $b} keys(%sone))) {
+ foreach (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
$r->print('<td>');
if (defined($$hash{$_})) { $r->print($$hash{$_}); }
$r->print('</td>');
@@ -3781,8 +4063,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".
'<table border="2"><tr>'.
'<th>'.&mt('Attribute').'</th>'.
@@ -3794,7 +4076,7 @@ sub csv_print_select_table {
$r->print('<td><select name=f'.$i.
' onchange="javascript:flip(this.form,'.$i.');">');
$r->print('<option value="none"></option>');
- foreach (sort({$a <=> $b} keys(%sone))) {
+ foreach (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
$r->print('<option value="'.$_.'"'.
($_ eq $defaultcol ? ' selected="selected" ' : '').
'>Column '.($_+1).'</option>');
@@ -3825,28 +4107,27 @@ $d is an array of 2 element arrays (inte
######################################################
sub csv_samples_select_table {
my ($r,$records,$d) = @_;
- my %sone; my %stwo; my %sthree;
my $i=0;
#
+ my $samples = &get_samples($records,3);
$r->print('<table border=2><tr><th>'.
&mt('Field').'</th><th>'.&mt('Samples').'</th></tr>');
- %sone=&record_sep($$records[0]);
- if (defined($$records[1])) {%stwo=&record_sep($$records[1]);}
- if (defined($$records[2])) {%sthree=&record_sep($$records[2]);}
- #
- foreach (sort keys %sone) {
+
+ foreach my $key (sort(keys(%{ $samples->[0] }))) {
$r->print('<tr><td><select name="f'.$i.'"'.
' onchange="javascript:flip(this.form,'.$i.');">');
- foreach (@$d) {
- my ($value,$display,$defaultcol)=@{ $_ };
+ foreach my $option (@$d) {
+ my ($value,$display,$defaultcol)=@{ $option };
$r->print('<option value="'.$value.'"'.
($i eq $defaultcol ? ' selected="selected" ':'').'>'.
$display.'</option>');
}
$r->print('</select></td><td>');
- if (defined($sone{$_})) { $r->print($sone{$_}."<br />\n"); }
- if (defined($stwo{$_})) { $r->print($stwo{$_}."<br />\n"); }
- if (defined($sthree{$_})) { $r->print($sthree{$_}."<br />\n"); }
+ foreach my $line (0..2) {
+ if (defined($samples->[$line]{$key})) {
+ $r->print($samples->[$line]{$key}."<br />\n");
+ }
+ }
$r->print('</td></tr>');
$i++;
}