[LON-CAPA-cvs] cvs: loncom /automation batchcreatecourse.pm /interface loncommon.pm /lonnet/perl lonnet.pm
raeburn
raeburn@source.lon-capa.org
Sat, 15 Aug 2009 00:25:54 -0000
raeburn Sat Aug 15 00:25:54 2009 EDT
Modified files:
/loncom/automation batchcreatecourse.pm
/loncom/interface loncommon.pm
/loncom/lonnet/perl lonnet.pm
Log:
Course Requests.
- Pass additional arg to loncommon::construct_course() - category to identify whether requested course is official, unofficial or community.
- Pass two additional args to lonnet::createcourse() - context (e.g., requestcourses) and category
- used when checking that requestor has rights to request a course (check via &usertools_access())
- Additional role assgnment rights check in &lonnet::assignrole().
Support case where a requestor is creating a course, and as course owner needs CC role
These rights only applies where context is "requestcourses", and user is adding his/her own cc role, and is identified as course owner.
- Defalt to using $en{'user.name'} and $env{'user.domain'} if not supplied in the args to &store_userdata().
Index: loncom/automation/batchcreatecourse.pm
diff -u loncom/automation/batchcreatecourse.pm:1.29 loncom/automation/batchcreatecourse.pm:1.30
--- loncom/automation/batchcreatecourse.pm:1.29 Sat Aug 15 00:05:54 2009
+++ loncom/automation/batchcreatecourse.pm Sat Aug 15 00:25:34 2009
@@ -1,5 +1,5 @@
#
-# $Id: batchcreatecourse.pm,v 1.29 2009/08/15 00:05:54 raeburn Exp $
+# $Id: batchcreatecourse.pm,v 1.30 2009/08/15 00:25:34 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -511,7 +511,7 @@
$$logmsg .= &mt('Invalid home server for course').': '.$details->{'coursehome'};
return;
}
- my ($success, $msg) = &Apache::loncommon::construct_course($courseargs,$logmsg,\$courseid,\$crsudom,\$crsunum,$udom,$uname,$context,$cnum);
+ my ($success, $msg) = &Apache::loncommon::construct_course($courseargs,$logmsg,\$courseid,\$crsudom,\$crsunum,$udom,$uname,$context,$cnum,$category);
$$logmsg .= $msg;
if (!$success) {
return;
Index: loncom/interface/loncommon.pm
diff -u loncom/interface/loncommon.pm:1.884 loncom/interface/loncommon.pm:1.885
--- loncom/interface/loncommon.pm:1.884 Fri Aug 14 23:54:34 2009
+++ loncom/interface/loncommon.pm Sat Aug 15 00:25:43 2009
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.884 2009/08/14 23:54:34 raeburn Exp $
+# $Id: loncommon.pm,v 1.885 2009/08/15 00:25:43 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -9890,7 +9890,7 @@
}
sub construct_course {
- my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum) = @_;
+ my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category) = @_;
my $outcome;
my $linefeed = '<br />'."\n";
if ($context eq 'auto') {
@@ -9929,7 +9929,7 @@
$args->{'ccuname'}.':'.
$args->{'ccdomain'},
$args->{'crstype'},
- $cnum);
+ $cnum,$context,$category);
# Note: The testing routines depend on this being output; see
# Utils::Course. This needs to at least be output as a comment
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.1016 loncom/lonnet/perl/lonnet.pm:1.1017
--- loncom/lonnet/perl/lonnet.pm:1.1016 Fri Aug 14 17:46:10 2009
+++ loncom/lonnet/perl/lonnet.pm Sat Aug 15 00:25:53 2009
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.1016 2009/08/14 17:46:10 raeburn Exp $
+# $Id: lonnet.pm,v 1.1017 2009/08/15 00:25:53 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -6102,7 +6102,17 @@
if ($refused) {
if (($selfenroll == 1) && ($role eq 'st') && ($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'})) {
$refused = '';
- } else {
+ } elsif ($context eq 'requestcourses') {
+ if (($role eq 'cc') && ($env{'user.name'} ne '' && $env{'user.domain'} ne '')) {
+ my ($cdom,$cnum) = ($cwosec =~ m{^/($match_domain)/($match_courseid)$});
+ my %crsenv = &userenvironment($cdom,$cnum,('internal.courseowner'));
+ if ($crsenv{'internal.courseowner'} eq
+ $env{'user.name'}.':'.$env{'user.domain'}) {
+ $refused = '';
+ }
+ }
+ }
+ if ($refused) {
&logthis('Refused assignrole: '.$udom.' '.$uname.' '.$url.
' '.$role.' '.$end.' '.$start.' by '.
$env{'user.name'}.' at '.$env{'user.domain'});
@@ -6426,11 +6436,17 @@
sub createcourse {
my ($udom,$description,$url,$course_server,$nonstandard,$inst_code,
- $course_owner,$crstype,$cnum)=@_;
+ $course_owner,$crstype,$cnum,$context,$category)=@_;
$url=&declutter($url);
my $cid='';
unless (&allowed('ccc',$udom)) {
- return 'refused';
+ if ($context eq 'requestcourses') {
+ unless (&usertools_access($course_owner,$udom,$category,undef,$context)) {
+ return 'refused';
+ }
+ } else {
+ return 'refused';
+ }
}
# --------------------------------------------------------------- Get Unique ID
my $uname;
@@ -6534,7 +6550,11 @@
my $result;
if ($datakey ne '') {
if (ref($storehash) eq 'HASH') {
- my $uhome=&homeserver();
+ if ($udom eq '' || $uname eq '') {
+ $udom = $env{'user.domain'};
+ $uname = $env{'user.name'};
+ }
+ my $uhome=&homeserver($uname,$udom);
if (($uhome eq '') || ($uhome eq 'no_host')) {
$result = 'error: no_host';
} else {