--- loncom/lonnet/perl/lonnet.pm 2011/10/31 13:44:37 1.1141
+++ loncom/lonnet/perl/lonnet.pm 2011/12/14 16:16:50 1.1148
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.1141 2011/10/31 13:44:37 raeburn Exp $
+# $Id: lonnet.pm,v 1.1148 2011/12/14 16:16:50 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -1920,6 +1920,7 @@ sub get_domain_defaults {
$domdefaults{'auth_arg_def'} = $domconfig{'defaults'}{'auth_arg_def'};
$domdefaults{'timezone_def'} = $domconfig{'defaults'}{'timezone_def'};
$domdefaults{'datelocale_def'} = $domconfig{'defaults'}{'datelocale_def'};
+ $domdefaults{'portal_def'} = $domconfig{'defaults'}{'portal_def'};
} else {
$domdefaults{'lang_def'} = &domain($domain,'lang_def');
$domdefaults{'auth_def'} = &domain($domain,'auth_def');
@@ -2429,10 +2430,11 @@ sub subscribe {
sub repcopy {
my $filename=shift;
$filename=~s/\/+/\//g;
- if ($filename=~m|^/home/httpd/html/adm/|) { return 'ok'; }
- if ($filename=~m|^/home/httpd/html/lonUsers/|) { return 'ok'; }
- if ($filename=~m|^/home/httpd/html/userfiles/| or
- $filename=~m -^/*(uploaded|editupload)/-) {
+ my $londocroot = $perlvar{'lonDocRoot'};
+ if ($filename=~m{^\Q$londocroot/adm/\E}) { return 'ok'; }
+ if ($filename=~m{^\Q$londocroot/lonUsers/\E}) { return 'ok'; }
+ if ($filename=~m{^\Q$londocroot/userfiles/\E} or
+ $filename=~m{^/*(uploaded|editupload)/}) {
return &repcopy_userfile($filename);
}
$filename=~s/[\n\r]//g;
@@ -2459,7 +2461,7 @@ sub repcopy {
unless ($home eq $perlvar{'lonHostID'}) {
my @parts=split(/\//,$filename);
my $path="/$parts[1]/$parts[2]/$parts[3]/$parts[4]";
- if ($path ne "$perlvar{'lonDocRoot'}/res") {
+ if ($path ne "$londocroot/res") {
&logthis("Malconfiguration for replication: $filename");
return 'bad_request';
}
@@ -3337,7 +3339,7 @@ sub courseacclog {
my $fnsymb=shift;
unless ($env{'request.course.id'}) { return ''; }
my $what=$fnsymb.':'.$env{'user.name'}.':'.$env{'user.domain'};
- if ($fnsymb=~/(problem|exam|quiz|assess|survey|form|task|page)$/) {
+ if ($fnsymb=~/$LONCAPA::assess_re/) {
$what.=':POST';
# FIXME: Probably ought to escape things....
foreach my $key (keys(%env)) {
@@ -7513,14 +7515,16 @@ sub modify_student_enrollment {
$uid = $tmp{'id'} if (!defined($uid) || $uid eq '');
}
my $fullname = &format_name($first,$middle,$last,$gene,'lastname');
+ my $user = "$uname:$udom";
+ my %old_entry = &Apache::lonnet::get('classlist',[$user],$cdom,$cnum);
my $reply=cput('classlist',
- {"$uname:$udom" =>
+ {$user =>
join(':',$end,$start,$uid,$usec,$fullname,$type,$locktype) },
$cdom,$cnum);
- unless (($reply eq 'ok') || ($reply eq 'delayed')) {
+ if (($reply eq 'ok') || ($reply eq 'delayed')) {
+ &devalidate_getsection_cache($udom,$uname,$cid);
+ } else {
return 'error: '.$reply;
- } else {
- &devalidate_getsection_cache($udom,$uname,$cid);
}
# Add student role to user
my $uurl='/'.$cid;
@@ -7528,7 +7532,16 @@ sub modify_student_enrollment {
if ($usec) {
$uurl.='/'.$usec;
}
- return &assignrole($udom,$uname,$uurl,'st',$end,$start,undef,$selfenroll,$context);
+ my $result = &assignrole($udom,$uname,$uurl,'st',$end,$start,undef,
+ $selfenroll,$context);
+ if ($result ne 'ok') {
+ if ($old_entry{$user} ne '') {
+ $reply = &cput('classlist',\%old_entry,$cdom,$cnum);
+ } else {
+ $reply = &del('classlist',[$user],$cdom,$cnum);
+ }
+ }
+ return $result;
}
sub format_name {
@@ -8708,15 +8721,7 @@ sub EXT {
} elsif ($realm eq 'request') {
# ------------------------------------------------------------- request.browser
if ($space eq 'browser') {
- if ($qualifier eq 'textremote') {
- if (&Apache::lonlocal::mt('textual_remote_display') eq 'on') {
- return 1;
- } else {
- return 0;
- }
- } else {
- return $env{'browser.'.$qualifier};
- }
+ return $env{'browser.'.$qualifier};
# ------------------------------------------------------------ request.filename
} else {
return $env{'request.'.$spacequalifierrest};
@@ -9758,9 +9763,11 @@ sub rndseed {
if (!defined($symb)) {
unless ($symb=$wsymb) { return time; }
}
- if (!$courseid) { $courseid=$wcourseid; }
- if (!$domain) { $domain=$wdomain; }
- if (!$username) { $username=$wusername }
+ if (!defined $courseid) {
+ $courseid=$wcourseid;
+ }
+ if (!defined $domain) { $domain=$wdomain; }
+ if (!defined $username) { $username=$wusername }
my $which;
if (defined($cenv->{'rndseed'})) {
@@ -9768,7 +9775,6 @@ sub rndseed {
} else {
$which =&get_rand_alg($courseid);
}
-
if (defined(&getCODE())) {
if ($which eq '64bit5') {
@@ -10094,8 +10100,9 @@ sub getfile {
sub repcopy_userfile {
my ($file)=@_;
- if ($file =~ m -^/*(uploaded|editupload)/-) { $file=&filelocation("",$file); }
- if ($file =~ m|^/home/httpd/html/lonUsers/|) { return 'ok'; }
+ my $londocroot = $perlvar{'lonDocRoot'};
+ if ($file =~ m{^/*(uploaded|editupload)/}) { $file=&filelocation("",$file); }
+ if ($file =~ m{^\Q$londocroot/lonUsers/\E}) { return 'ok'; }
my ($cdom,$cnum,$filename) =
($file=~m|^\Q$perlvar{'lonDocRoot'}\E/+userfiles/+($match_domain)/+($match_name)/+(.*)|);
my $uri="/uploaded/$cdom/$cnum/$filename";
@@ -10248,7 +10255,7 @@ sub filelocation {
if ( !( $file =~ m:^/:) ) {
$location = $dir. '/'.$file;
} else {
- $location = '/home/httpd/html/'.$space.$file;
+ $location = $perlvar{'lonDocRoot'}.'/'.$space.$file;
}
}
$location=~s://+:/:g; # remove duplicate /
@@ -10274,8 +10281,8 @@ sub hreflocation {
if ($file=~m-^\Q$perlvar{'lonDocRoot'}\E-) {
$file=~s-^\Q$perlvar{'lonDocRoot'}\E--;
} elsif ($file=~m-^\Q$perlvar{'lonUsersDir'}\E-) {
- $file=~s-^/home/httpd/lonUsers/($match_domain)/./././($match_name)/userfiles/
- -/uploaded/$1/$2/-x;
+ $file=~s{^/home/httpd/lonUsers/($match_domain)/./././($match_name)/userfiles/}
+ {/uploaded/$1/$2/}x;
}
if ($file=~ m{^/userfiles/}) {
$file =~ s{^/userfiles/}{/uploaded/};