--- loncom/lonnet/perl/lonnet.pm 2005/11/22 00:01:53 1.683 +++ loncom/lonnet/perl/lonnet.pm 2005/12/19 21:03:53 1.686 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.683 2005/11/22 00:01:53 raeburn Exp $ +# $Id: lonnet.pm,v 1.686 2005/12/19 21:03:53 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -40,8 +40,8 @@ qw(%perlvar %hostname %badServerCache %i %courselogs %accesshash %userrolehash %domainrolehash $processmarker $dumpcount %coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseownerbuf %domaindescription %domain_auth_def %domain_auth_arg_def - %domain_lang_def %domain_city %domain_longi %domain_lati $tmpdir $_64bit - %env); + %domain_lang_def %domain_city %domain_longi %domain_lati %domain_primary + $tmpdir $_64bit %env); use IO::Socket; use GDBM_File; @@ -1280,8 +1280,15 @@ sub clean_filename { } # --------------- Take an uploaded file and put it into the userfiles directory -# input: name of form element, coursedoc=1 means this is for the course -# output: url of file in userspace +# input: $formname - the contents of the file are in $env{"form.$formname"} +# the desired filenam is in $env{"form.$formname"} +# $coursedoc - if true up to the current course +# if false +# $subdir - directory in userfile to store the file into +# $parser, $allfiles, $codebase - unknown +# +# output: url of file in userspace, or error: +# or /adm/notfound.html if failure to upload occurse sub userfileupload { @@ -1853,28 +1860,25 @@ sub courseiddump { # ---------------------------------------------------------- DC e-mail sub dcmailput { - my ($domain,$msgid,$contents,$server)=@_; + my ($domain,$msgid,$message,$server)=@_; my $status = &Apache::lonnet::critical( 'dcmailput:'.$domain.':'.&Apache::lonnet::escape($msgid).'='. - &Apache::lonnet::escape($$contents{$server}),$server); + &Apache::lonnet::escape($message),$server); return $status; } sub dcmaildump { my ($dom,$startdate,$enddate,$senders) = @_; - my %returnhash=(); - foreach my $tryserver (keys(%libserv)) { - if ($hostdom{$tryserver} eq $dom) { - %{$returnhash{$tryserver}}=(); - my $cmd='dcmaildump:'.$dom.':'. - &escape($startdate).':'.&escape($enddate).':'; - my @esc_senders=map { &escape($_)} @$senders; - $cmd.=&escape(join('&',@esc_senders)); - foreach (split(/\&/,&reply($cmd,$tryserver))) { - my ($key,$value) = split(/\=/,$_); - if (($key) && ($value)) { - $returnhash{$tryserver}{&unescape($key)} = &unescape($value); - } + my %returnhash=(); + if (exists($domain_primary{$dom})) { + my $cmd='dcmaildump:'.$dom.':'.&escape($startdate).':'. + &escape($enddate).':'; + my @esc_senders=map { &escape($_)} @$senders; + $cmd.=&escape(join('&',@esc_senders)); + foreach (split(/\&/,&reply($cmd,$domain_primary{$dom}))) { + my ($key,$value) = split(/\=/,$_); + if (($key) && ($value)) { + $returnhash{&unescape($key)} = &unescape($value); } } } @@ -3718,6 +3722,10 @@ sub modify_group_roles { my $role = 'gr/'.&escape($userprivs); my ($uname,$udom) = split(/:/,$user); my $result = &assignrole($udom,$uname,$url,$role,$end,$start); + if ($result eq 'ok') { + &devalidate_getgroups_cache($udom,$uname,$cdom,$cnum); + } + return $result; } @@ -4801,7 +4809,8 @@ sub EXT { return $env{'course.'.$courseid.'.'.$spacequalifierrest}; } elsif ($realm eq 'resource') { - my $section; + my ($section,$group); + my @groups = (); if (defined($courseid) && $courseid eq $env{'request.course.id'}) { if (!$symbparm) { $symbparm=&symbread(); } } @@ -4821,14 +4830,29 @@ sub EXT { if (($env{'user.name'} eq $uname) && ($env{'user.domain'} eq $udom)) { $section=$env{'request.course.sec'}; + @groups=split(/:/,$env{'request.course.groups'}); + if (@groups > 0) { + @groups = sort(@groups); + $group = $groups[0]; + } } else { if (! defined($usection)) { $section=&getsection($udom,$uname,$courseid); } else { $section = $usection; } + my $grouplist = &get_users_groups($udom,$uname,$courseid); + if ($grouplist) { + @groups = split(/:/,$grouplist); + @groups = sort(@groups); + $group = $groups[0]; + } } + my $grplevel=$courseid.'.['.$group.'].'.$spacequalifierrest; + my $grplevelr=$courseid.'.['.$group.'].'.$symbparm; + my $grplevelm=$courseid.'.['.$group.'].'.$mapparm; + my $seclevel=$courseid.'.['.$section.'].'.$spacequalifierrest; my $seclevelr=$courseid.'.['.$section.'].'.$symbparm; my $seclevelm=$courseid.'.['.$section.'].'.$mapparm; @@ -4846,8 +4870,17 @@ sub EXT { if (defined($userreply)) { return $userreply; } # ------------------------------------------------ second, check some of course + my $coursereply; + if (defined($group)) { + $coursereply = &resdata($env{'course.'.$courseid.'.num'}, + $env{'course.'.$courseid.'.domain'}, + 'course', + ($grplevelr,$grplevelm,$grplevel, + $courselevelr)); + if (defined($coursereply)) { return $coursereply; } + } - my $coursereply=&resdata($env{'course.'.$courseid.'.num'}, + $coursereply=&resdata($env{'course.'.$courseid.'.num'}, $env{'course.'.$courseid.'.domain'}, 'course', ($seclevelr,$seclevelm,$seclevel, @@ -6185,7 +6218,7 @@ BEGIN { # next if /^\#/; chomp; my ($domain, $domain_description, $def_auth, $def_auth_arg, - $def_lang, $city, $longi, $lati) = split(/:/,$_); + $def_lang, $city, $longi, $lati, $primary) = split(/:/,$_); $domain_auth_def{$domain}=$def_auth; $domain_auth_arg_def{$domain}=$def_auth_arg; $domaindescription{$domain}=$domain_description; @@ -6193,6 +6226,7 @@ BEGIN { $domain_city{$domain}=$city; $domain_longi{$domain}=$longi; $domain_lati{$domain}=$lati; + $domain_primary{$domain}=$primary; # &logthis("Domain.tab: $domain, $domain_auth_def{$domain}, $domain_auth_arg_def{$domain},$domaindescription{$domain}"); # &logthis("Domain.tab: $domain ".$domaindescription{$domain} );