--- loncom/lonnet/perl/lonnet.pm 2009/08/11 01:39:44 1.1013 +++ loncom/lonnet/perl/lonnet.pm 2009/08/22 21:11:19 1.1021 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1013 2009/08/11 01:39:44 raeburn Exp $ +# $Id: lonnet.pm,v 1.1021 2009/08/22 21:11:19 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -3146,10 +3146,10 @@ sub dcmaildump { sub get_domain_roles { my ($dom,$roles,$startdate,$enddate)=@_; - if (undef($startdate) || $startdate eq '') { + if ((!defined($startdate)) || ($startdate eq '')) { $startdate = '.'; } - if (undef($enddate) || $enddate eq '') { + if ((!defined($enddate)) || ($enddate eq '')) { $enddate = '.'; } my $rolelist; @@ -5874,13 +5874,37 @@ sub auto_possible_instcodes { sub auto_courserequest_checks { my ($dom) = @_; - my %validations; + my ($homeserver,%validations); + if ($dom =~ /^$match_domain$/) { + $homeserver = &domain($dom,'primary'); + } + unless ($homeserver eq 'no_host') { + my $response=&reply('autocrsreqchecks:'.$dom,$homeserver); + unless ($response =~ /(con_lost|error|no_such_host|refused)/) { + my @items = split(/&/,$response); + foreach my $item (@items) { + my ($key,$value) = split('=',$item); + $validations{&unescape($key)} = &thaw_unescape($value); + } + } + } return %validations; } sub auto_courserequest_validation { - my ($dom,$details,$inststatuses,$message) = @_; - return 'pending'; + my ($dom,$owner,$crstype,$inststatuslist,$instcode,$instseclist) = @_; + my ($homeserver,$response); + if ($dom =~ /^$match_domain$/) { + $homeserver = &domain($dom,'primary'); + } + unless ($homeserver eq 'no_host') { + + $response=&unescape(&reply('autocrsreqvalidation:'.$dom.':'.&escape($owner). + ':'.&escape($crstype).':'.&escape($inststatuslist). + ':'.&escape($instcode).':'.&escape($instseclist), + $homeserver)); + } + return $response; } sub auto_validate_class_sec { @@ -6102,7 +6126,17 @@ sub assignrole { 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 +6460,17 @@ sub writecoursepref { 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; @@ -6529,13 +6569,16 @@ sub is_course { return 0; } -sub store_coursereq { - my ($requestkey,$storehash) = @_; +sub store_userdata { + my ($storehash,$datakey,$namespace,$udom,$uname) = @_; my $result; - if ($requestkey =~ /^($match_domain)_($match_courseid)$/) { + if ($datakey ne '') { if (ref($storehash) eq 'HASH') { - my $namespace = 'courserequests'; - 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 { @@ -6548,7 +6591,7 @@ sub store_coursereq { } $namevalue=~s/\&$//; $result = &reply("store:$env{'user.domain'}:$env{'user.name'}:". - "$namespace:$requestkey:$namevalue",$uhome); + "$namespace:$datakey:$namevalue",$uhome); } } else { $result = 'error: data to store was not a hash reference'; @@ -8048,6 +8091,11 @@ sub devalidate_title_cache { &devalidate_cache_new('title',$key); } +# ------------------------------------------------- Get the title of a course + +sub current_course_title { + return $env{ 'course.' . $env{'request.course.id'} . '.description' }; +} # ------------------------------------------------- Get the title of a resource sub gettitle {