--- loncom/interface/loncommon.pm 2010/02/12 17:53:43 1.940
+++ loncom/interface/loncommon.pm 2010/03/10 21:25:49 1.949
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.940 2010/02/12 17:53:43 bisitz Exp $
+# $Id: loncommon.pm,v 1.949 2010/03/10 21:25:49 droeschl Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -1202,12 +1202,7 @@ ENDOUTPUT
sub help_open_menu {
my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text)
= @_;
- $stayOnPage = 0 if (not defined $stayOnPage);
- # only use pop-up help (stayOnPage == 0)
- # if environment.remote is on (using remote control UI)
- if ($env{'environment.remote'} eq 'off' ) {
- $stayOnPage=1;
- }
+ $stayOnPage = 1;
my $output;
if ($component_help) {
if (!$text) {
@@ -1228,8 +1223,8 @@ sub help_open_menu {
sub top_nav_help {
my ($text) = @_;
$text = &mt($text);
- my $stay_on_page =
- ($env{'environment.remote'} eq 'off' );
+ my $stay_on_page = 1;
+
my $link = ($stay_on_page) ? "javascript:helpMenu('display')"
: "javascript:helpMenu('open')";
my $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
@@ -1244,10 +1239,7 @@ END
sub help_menu_js {
my ($text) = @_;
-
- my $stayOnPage =
- ($env{'environment.remote'} eq 'off' );
-
+ my $stayOnPage = 1;
my $width = 620;
my $height = 600;
my $helptopic=&general_help();
@@ -1304,10 +1296,7 @@ sub help_open_bug {
unless ($env{'user.adv'}) { return ''; }
unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
$text = "" if (not defined $text);
- $stayOnPage = 0 if (not defined $stayOnPage);
- if ($env{'environment.remote'} eq 'off' ) {
$stayOnPage=1;
- }
$width = 600 if (not defined $width);
$height = 600 if (not defined $height);
@@ -1348,10 +1337,7 @@ sub help_open_faq {
unless ($env{'user.adv'}) { return ''; }
unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
$text = "" if (not defined $text);
- $stayOnPage = 0 if (not defined $stayOnPage);
- if ($env{'environment.remote'} eq 'off' ) {
$stayOnPage=1;
- }
$width = 350 if (not defined $width);
$height = 400 if (not defined $height);
@@ -3412,12 +3398,22 @@ sub get_previous_attempt {
}
$prevattempts=&start_data_table().&start_data_table_header_row();
$prevattempts.='
'.&mt('History').' | ';
+ my %typeparts;
+ my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
foreach my $key (sort(keys(%lasthash))) {
my ($ign,@parts) = split(/\./,$key);
if ($#parts > 0) {
my $data=$parts[-1];
pop(@parts);
- $prevattempts.=''.&mt('Part ').join('.',@parts).' '.$data.' | ';
+ if ($data eq 'type') {
+ unless ($showsurv) {
+ my $id = join(',',@parts);
+ $typeparts{$ign.'.'.$id} = $lasthash{$key};
+ }
+ delete($lasthash{$key});
+ } else {
+ $prevattempts.=''.&mt('Part ').join('.',@parts).' '.$data.' | ';
+ }
} else {
if ($#parts == 0) {
$prevattempts.=''.$parts[0].' | ';
@@ -3427,23 +3423,98 @@ sub get_previous_attempt {
}
}
$prevattempts.=&end_data_table_header_row();
+ my %lasthidden;
if ($getattempt eq '') {
for ($version=1;$version<=$returnhash{'version'};$version++) {
- $prevattempts.=&start_data_table_row().
- ''.&mt('Transaction [_1]',$version).' | ';
- foreach my $key (sort(keys(%lasthash))) {
- my $value = &format_previous_attempt_value($key,
- $returnhash{$version.':'.$key});
- $prevattempts.=''.$value.' | ';
- }
- $prevattempts.=&end_data_table_row();
+ my @hidden;
+ if (%typeparts) {
+ foreach my $id (keys(%typeparts)) {
+ if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') || ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
+ push(@hidden,$id);
+ $lasthidden{$id} = 1;
+ } elsif ($lasthidden{$id}) {
+ if (exists($returnhash{$version.':'.$id.'.award'})) {
+ delete($lasthidden{$id});
+ }
+ }
+ }
+ }
+ $prevattempts.=&start_data_table_row().
+ ''.&mt('Transaction [_1]',$version).' | ';
+ if (@hidden) {
+ foreach my $key (sort(keys(%lasthash))) {
+ my $hide;
+ foreach my $id (@hidden) {
+ if ($key =~ /^\Q$id\E/) {
+ $hide = 1;
+ last;
+ }
+ }
+ if ($hide) {
+ my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
+ if (($data eq 'award') || ($data eq 'awarddetail')) {
+ my $value = &format_previous_attempt_value($key,
+ $returnhash{$version.':'.$key});
+ $prevattempts.=''.$value.' | ';
+ } else {
+ $prevattempts.=' | ';
+ }
+ } else {
+ if ($key =~ /\./) {
+ my $value = &format_previous_attempt_value($key,
+ $returnhash{$version.':'.$key});
+ $prevattempts.=''.$value.' | ';
+ } else {
+ $prevattempts.=' | ';
+ }
+ }
+ }
+ } else {
+ foreach my $key (sort(keys(%lasthash))) {
+ my $value = &format_previous_attempt_value($key,
+ $returnhash{$version.':'.$key});
+ $prevattempts.=''.$value.' | ';
+ }
+ }
+ $prevattempts.=&end_data_table_row();
}
}
+ my @currhidden = keys(%lasthidden);
$prevattempts.=&start_data_table_row().''.&mt('Current').' | ';
foreach my $key (sort(keys(%lasthash))) {
- my $value = &format_previous_attempt_value($key,$lasthash{$key});
- if ($key =~/$regexp$/ && (defined &$gradesub)) {$value = &$gradesub($value)}
- $prevattempts.=''.$value.' | ';
+ if (%typeparts) {
+ my $hidden;
+ foreach my $id (@currhidden) {
+ if ($key =~ /^\Q$id\E/) {
+ $hidden = 1;
+ last;
+ }
+ }
+ if ($hidden) {
+ my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
+ if (($data eq 'award') || ($data eq 'awarddetail')) {
+ my $value = &format_previous_attempt_value($key,$lasthash{$key});
+ if ($key =~/$regexp$/ && (defined &$gradesub)) {
+ $value = &$gradesub($value);
+ }
+ $prevattempts.=''.$value.' | ';
+ } else {
+ $prevattempts.=' | ';
+ }
+ } else {
+ my $value = &format_previous_attempt_value($key,$lasthash{$key});
+ if ($key =~/$regexp$/ && (defined &$gradesub)) {
+ $value = &$gradesub($value);
+ }
+ $prevattempts.=''.$value.' | ';
+ }
+ } else {
+ my $value = &format_previous_attempt_value($key,$lasthash{$key});
+ if ($key =~/$regexp$/ && (defined &$gradesub)) {
+ $value = &$gradesub($value);
+ }
+ $prevattempts.=''.$value.' | ';
+ }
}
$prevattempts.= &end_data_table_row().&end_data_table();
} else {
@@ -4146,16 +4217,39 @@ sub get_domainconf {
if (defined($cached)) { return %{$result}; }
my %domconfig = &Apache::lonnet::get_dom('configuration',
- ['login','rolecolors'],$udom);
+ ['login','rolecolors','autoenroll'],$udom);
my (%designhash,%legacy);
if (keys(%domconfig) > 0) {
if (ref($domconfig{'login'}) eq 'HASH') {
if (keys(%{$domconfig{'login'}})) {
foreach my $key (keys(%{$domconfig{'login'}})) {
if (ref($domconfig{'login'}{$key}) eq 'HASH') {
- foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
- $designhash{$udom.'.login.'.$key.'_'.$img} =
- $domconfig{'login'}{$key}{$img};
+ if ($key eq 'loginvia') {
+ if (ref($domconfig{'login'}{'loginvia'}) eq 'HASH') {
+ my @ids = &Apache::lonnet::current_machine_ids();
+ foreach my $hostname (@ids) {
+ if (ref($domconfig{'login'}{'loginvia'}{$hostname}) eq 'HASH') {
+ if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
+ my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
+ $designhash{$udom.'.login.loginvia'} = $server;
+ if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
+
+ $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
+ } else {
+ $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
+ }
+ if ($domconfig{'login'}{'loginvia'}{$hostname}{'exempt'}) {
+ $designhash{$udom.'.login.loginvia_exempt_'.$hostname} = $domconfig{'login'}{'loginvia'}{$hostname}{'exempt'};
+ }
+ }
+ }
+ }
+ }
+ } else {
+ foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
+ $designhash{$udom.'.login.'.$key.'_'.$img} =
+ $domconfig{'login'}{$key}{$img};
+ }
}
} else {
$designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
@@ -4182,6 +4276,11 @@ sub get_domainconf {
} else {
$legacy{'rolecolors'} = 1;
}
+ if (ref($domconfig{'autoenroll'}) eq 'HASH') {
+ if ($domconfig{'autoenroll'}{'co-owners'}) {
+ $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
+ }
+ }
if (keys(%legacy) > 0) {
my %legacyhash = &get_legacy_domconf($udom);
foreach my $item (keys(%legacyhash)) {
@@ -4437,9 +4536,9 @@ Inputs:
=item * $bgcolor, used to override the bgcolor on a webpage to a specific value
-=item * $no_inline_link, if true and in remote mode, don't show the
- 'Switch To Inline Menu' link
-
+#RC =item * $no_inline_link, if true and in remote mode, don't show the
+#RC 'Switch To Inline Menu' link
+#RC
=item * $args, optional argument valid values are
no_auto_mt_title -> prevents &mt()ing the title arg
inherit_jsmath -> when creating popup window in a page,
@@ -4529,7 +4628,6 @@ sub bodytag {
$role = '('.$role.')' if $role;
&get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
- if ($env{'environment.remote'} eq 'off') {
# No Remote
if ($no_nav_bar || $env{'form.inhibitmenu'} eq 'yes') {
return $bodytag;
@@ -4585,40 +4683,6 @@ sub bodytag {
}
return $bodytag;
- }
-
-#
-# Top frame rendering, Remote is up
-#
-
- my $imgsrc = $img;
- if ($img =~ /^\/adm/) {
- $imgsrc = &lonhttpdurl($img);
- }
- my $upperleft='';
-
- # Explicit link to get inline menu
- my $menu= ($no_inline_link?''
- :''.&mt('Switch to Inline Menu Mode').'');
-
- if ($dc_info) {
- $dc_info = qq|($dc_info)|;
- }
-
- $bodytag .= qq|$name $role
- $realm $dc_info
| unless $env{'form.inhibitmenu'};
- return(<
-$upperleft |
- $messages |
-
-$titleinfo $dc_info $menu |
-
-
-ENDBODY
}
sub dc_courseid_toggle {
@@ -4768,6 +4832,14 @@ sub standard_css {
return < hash ref of
head -> skip the generation
body -> skip all generation
- no_inline_link -> if true and in remote mode, don't show the
- 'Switch To Inline Menu' link
+#RC no_inline_link -> if true and in remote mode, don't show the
+#RC 'Switch To Inline Menu' link
no_auto_mt_title -> prevent &mt()ing the title arg
inherit_jsmath -> when creating popup window in a page,
should it have jsmath forced on by the
@@ -6691,7 +6777,8 @@ sub start_page {
return $result if $args->{'only_body'};
#Breadcrumbs for Construction Space provided by &bodytag.
- if (($env{'environment.remote'} eq 'off') && ($env{'request.state'} eq 'construct')) {
+ if (
+ $env{'request.state'} eq 'construct') {
return $result;
}
@@ -9988,19 +10075,19 @@ sub check_clone {
my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
my $clonemsg;
my $can_clone = 0;
- my $lctype = lc($args->{'type'});
+ my $lctype = lc($args->{'crstype'});
if ($lctype ne 'community') {
$lctype = 'course';
}
if ($clonehome eq 'no_host') {
- if ($args->{'type'} eq 'Community') {
+ if ($args->{'crstype'} eq 'Community') {
$clonemsg = &mt('No new community created.').$linefeed.&mt('A new community could not be cloned from the specified original - [_1] - because it is a non-existent community.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});
} else {
$clonemsg = &mt('No new course created.').$linefeed.&mt('A new course could not be cloned from the specified original - [_1] - because it is a non-existent course.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});
}
} else {
my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
- if ($args->{'type'} eq 'Community') {
+ if ($args->{'crstype'} eq 'Community') {
if ($clonedesc{'type'} ne 'Community') {
$clonemsg = &mt('No new community created.').$linefeed.&mt('A new community could not be cloned from the specified original - [_1] - because it is a course not a community.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});
return ($can_clone, $clonemsg, $cloneid, $clonehome);
@@ -10019,7 +10106,7 @@ sub check_clone {
$can_clone = 1;
} else {
my $ccrole = 'cc';
- if ($args->{'type'} eq 'Community') {
+ if ($args->{'crstype'} eq 'Community') {
$ccrole = 'co';
}
my %roleshash =
@@ -10028,9 +10115,11 @@ sub check_clone {
'userroles',['active'],[$ccrole],
[$args->{'clonedomain'}]);
if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
- $can_clone = 1;
- } else {
- if ($args->{'type'} eq 'Community') {
+ $can_clone = 1;
+ } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},$args->{'ccuname'},$args->{'ccdomain'})) {
+ $can_clone = 1;
+ } else {
+ if ($args->{'crstype'} eq 'Community') {
$clonemsg = &mt('No new community created.').$linefeed.&mt('The new community could not be cloned from the existing community because the new community owner ([_1]) does not have cloning rights in the existing community ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});
} else {
$clonemsg = &mt('No new course created.').$linefeed.&mt('The new course could not be cloned from the existing course because the new course owner ([_1]) does not have cloning rights in the existing course ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});
@@ -10089,11 +10178,19 @@ sub construct_course {
# if anyone ever decides to not show this, and Utils::Course::new
# will need to be suitably modified.
$outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
+ if ($$courseid =~ /^error:/) {
+ return (0,$outcome);
+ }
+
#
# Check if created correctly
#
($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
+ if ($crsuhome eq 'no_host') {
+ $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
+ return (0,$outcome);
+ }
$outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
#
@@ -10540,15 +10637,12 @@ sub init_user_environment {
my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
my ($tmp) = keys(%userenv);
if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
- # default remote control to off
- if ($userenv{'remote'} ne 'on') { $userenv{'remote'} = 'off'; }
} else {
undef(%userenv);
}
if (($userenv{'interface'}) && (!$form->{'interface'})) {
$form->{'interface'}=$userenv{'interface'};
}
- $env{'environment.remote'}=$userenv{'remote'};
if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
# --------------- Do not trust query string to be put directly into environment
@@ -10580,9 +10674,6 @@ sub init_user_environment {
$initial_env{"browser.localres"} = $form->{'localres'};
}
- if ($public) {
- $initial_env{"environment.remote"} = "off";
- }
if ($form->{'interface'}) {
$form->{'interface'}=~s/\W//gs;
$initial_env{"browser.interface"} = $form->{'interface'};