loncom/lonnet/perl/lonnet.pm - diff

Return to lonnet.pm CVS log

Up to [LON-CAPA] / loncom / lonnet / perl

Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.986 and 1.1000

version 1.986, 2009/02/10 11:15:16	version 1.1000, 2009/05/13 01:30:49
Line 74 use strict;	Line 74 use strict;
use LWP::UserAgent();	use LWP::UserAgent();
use HTTP::Date;	use HTTP::Date;
use Image::Magick;	use Image::Magick;
use IO::Socket;

# use Date::Parse;
use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir	use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir
$_64bit %env %protocol);	$_64bit %env %protocol);

Line 198 sub get_server_timezone {	Line 196 sub get_server_timezone {
}	}
}	}

	sub get_server_loncaparev {
	my ($dom,$lonhost) = @_;
	if (defined($lonhost)) {
	if (!defined(&hostname($lonhost))) {
	undef($lonhost);
	}
	}
	if (!defined($lonhost)) {
	if (defined(&domain($dom,'primary'))) {
	$lonhost=&domain($dom,'primary');
	if ($lonhost eq 'no_host') {
	undef($lonhost);
	}
	}
	}
	if (defined($lonhost)) {
	my $cachetime = 24*3600;
	my ($loncaparev,$cached)=&is_cached_new('serverloncaparev',$lonhost);
	if (defined($cached)) {
	return $loncaparev;
	} else {
	my $loncaparev = &reply('serverloncaparev',$lonhost);
	return &do_cache_new('serverloncaparev',$lonhost,$loncaparev,$cachetime);
	}
	}
	}

# -------------------------------------------------- Non-critical communication	# -------------------------------------------------- Non-critical communication
sub subreply {	sub subreply {
my ($cmd,$server)=@_;	my ($cmd,$server)=@_;
Line 528 sub appenv {	Line 553 sub appenv {
# ----------------------------------------------------- Delete from Environment	# ----------------------------------------------------- Delete from Environment

sub delenv {	sub delenv {
my $delthis=shift;	my ($delthis,$regexp) = @_;
if (($delthis=~/user\.role/) \|\| ($delthis=~/user\.priv/)) {	if (($delthis=~/user\.role/) \|\| ($delthis=~/user\.priv/)) {
&logthis("<font color=\"blue\">WARNING: ".	&logthis("<font color=\"blue\">WARNING: ".
"Attempt to delete from environment ".$delthis);	"Attempt to delete from environment ".$delthis);
Line 541 sub delenv {	Line 566 sub delenv {
tie(my %disk_env,'GDBM_File',$env{'user.environment'},	tie(my %disk_env,'GDBM_File',$env{'user.environment'},
(&GDBM_WRITER()\|&GDBM_NOLOCK()),0640)) {	(&GDBM_WRITER()\|&GDBM_NOLOCK()),0640)) {
foreach my $key (keys(%disk_env)) {	foreach my $key (keys(%disk_env)) {
if ($key=~/^\Q$delthis\E/) {	if ($regexp) {
delete($env{$key});	if ($key=~/^$delthis/) {
delete($disk_env{$key});	delete($env{$key});
}	delete($disk_env{$key});
	}
	} else {
	if ($key=~/^\Q$delthis\E/) {
	delete($env{$key});
	delete($disk_env{$key});
	}
	}
}	}
untie(%disk_env);	untie(%disk_env);
}	}
Line 998 sub put_dom {	Line 1030 sub put_dom {
sub retrieve_inst_usertypes {	sub retrieve_inst_usertypes {
my ($udom) = @_;	my ($udom) = @_;
my (%returnhash,@order);	my (%returnhash,@order);
if (defined(&domain($udom,'primary'))) {	my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
my $uhome=&domain($udom,'primary');	if ((ref($domdefs{'inststatustypes'}) eq 'HASH') &&
my $rep=&reply("inst_usertypes:$udom",$uhome);	(ref($domdefs{'inststatusorder'}) eq 'ARRAY')) {
if ($rep =~ /^(con_lost\|error\|no_such_host\|refused)/) {	%returnhash = %{$domdefs{'inststatustypes'}};
&logthis("get_dom failed - $rep returned from $uhome in domain: $udom");	@order = @{$domdefs{'inststatusorder'}};
return (\%returnhash,\@order);
}
my ($hashitems,$orderitems) = split(/:/,$rep);
my @pairs=split(/\&/,$hashitems);
foreach my $item (@pairs) {
my ($key,$value)=split(/=/,$item,2);
$key = &unescape($key);
next if ($key =~ /^error: 2 /);
$returnhash{$key}=&thaw_unescape($value);
}
my @esc_order = split(/\&/,$orderitems);
foreach my $item (@esc_order) {
push(@order,&unescape($item));
}
} else {	} else {
&logthis("get_dom failed - no primary domain server for $udom");	if (defined(&domain($udom,'primary'))) {
	my $uhome=&domain($udom,'primary');
	my $rep=&reply("inst_usertypes:$udom",$uhome);
	if ($rep =~ /^(con_lost\|error\|no_such_host\|refused)/) {
	&logthis("get_dom failed - $rep returned from $uhome in domain: $udom");
	return (\%returnhash,\@order);
	}
	my ($hashitems,$orderitems) = split(/:/,$rep);
	my @pairs=split(/\&/,$hashitems);
	foreach my $item (@pairs) {
	my ($key,$value)=split(/=/,$item,2);
	$key = &unescape($key);
	next if ($key =~ /^error: 2 /);
	$returnhash{$key}=&thaw_unescape($value);
	}
	my @esc_order = split(/\&/,$orderitems);
	foreach my $item (@esc_order) {
	push(@order,&unescape($item));
	}
	} else {
	&logthis("get_dom failed - no primary domain server for $udom");
	}
}	}
return (\%returnhash,\@order);	return (\%returnhash,\@order);
}	}
Line 1255 sub get_domain_defaults {	Line 1294 sub get_domain_defaults {
}	}
my %domdefaults;	my %domdefaults;
my %domconfig =	my %domconfig =
&Apache::lonnet::get_dom('configuration',['defaults','quotas'],$domain);	&Apache::lonnet::get_dom('configuration',['defaults','quotas',
	'requestcourses','inststatus'],$domain);
if (ref($domconfig{'defaults'}) eq 'HASH') {	if (ref($domconfig{'defaults'}) eq 'HASH') {
$domdefaults{'lang_def'} = $domconfig{'defaults'}{'lang_def'};	$domdefaults{'lang_def'} = $domconfig{'defaults'}{'lang_def'};
$domdefaults{'auth_def'} = $domconfig{'defaults'}{'auth_def'};	$domdefaults{'auth_def'} = $domconfig{'defaults'}{'auth_def'};
Line 1285 sub get_domain_defaults {	Line 1325 sub get_domain_defaults {
$domdefaults{$item} = $domconfig{'requestcourses'}{$item};	$domdefaults{$item} = $domconfig{'requestcourses'}{$item};
}	}
}	}
	if (ref($domconfig{'inststatus'}) eq 'HASH') {
	foreach my $item ('inststatustypes','inststatusorder') {
	$domdefaults{$item} = $domconfig{'inststatus'}{$item};
	}
	}
&Apache::lonnet::do_cache_new('domdefaults',$domain,\%domdefaults,	&Apache::lonnet::do_cache_new('domdefaults',$domain,\%domdefaults,
$cachetime);	$cachetime);
return %domdefaults;	return %domdefaults;
Line 1859 sub ssi {	Line 1904 sub ssi {
&Apache::lonenc::check_encrypt(\$fn);	&Apache::lonenc::check_encrypt(\$fn);
if (%form) {	if (%form) {
$request=new HTTP::Request('POST',&absolute_url().$fn);	$request=new HTTP::Request('POST',&absolute_url().$fn);
$request->content(join('&',map { &escape($_).'='.&escape($form{$_}) } keys %form));	$request->content(join('&',map { &escape($_).'='.&escape($form{$_}) } keys(%form)));
} else {	} else {
$request=new HTTP::Request('GET',&absolute_url().$fn);	$request=new HTTP::Request('GET',&absolute_url().$fn);
}	}
Line 2121 sub userfileupload {	Line 2166 sub userfileupload {
close($fh);	close($fh);
return $fullpath.'/'.$fname;	return $fullpath.'/'.$fname;
}	}
	if ($subdir eq 'scantron') {
	$fname = 'scantron_orig_'.$fname;
	} else {
# Create the directory if not present	# Create the directory if not present
$fname="$subdir/$fname";	$fname="$subdir/$fname";
	}
if ($coursedoc) {	if ($coursedoc) {
my $docuname=$env{'course.'.$env{'request.course.id'}.'.num'};	my $docuname=$env{'course.'.$env{'request.course.id'}.'.num'};
my $docudom=$env{'course.'.$env{'request.course.id'}.'.domain'};	my $docudom=$env{'course.'.$env{'request.course.id'}.'.domain'};
Line 2506 sub flushcourselogs {	Line 2554 sub flushcourselogs {
# Reverse lookup of domain roles (dc, ad, li, sc, au)	# Reverse lookup of domain roles (dc, ad, li, sc, au)
#	#
my %domrolebuffer = ();	my %domrolebuffer = ();
foreach my $entry (keys %domainrolehash) {	foreach my $entry (keys(%domainrolehash)) {
my ($role,$uname,$udom,$runame,$rudom,$rsec)=split(/:/,$entry);	my ($role,$uname,$udom,$runame,$rudom,$rsec)=split(/:/,$entry);
if ($domrolebuffer{$rudom}) {	if ($domrolebuffer{$rudom}) {
$domrolebuffer{$rudom}.='&'.&escape($entry).	$domrolebuffer{$rudom}.='&'.&escape($entry).
Line 2661 sub courserolelog {	Line 2709 sub courserolelog {
$storehash{'section'} = $sec;	$storehash{'section'} = $sec;
}	}
&instructor_log($namespace,\%storehash,$delflag,$username,$domain,$cnum,$cdom);	&instructor_log($namespace,\%storehash,$delflag,$username,$domain,$cnum,$cdom);
	if (($trole ne 'st') \|\| ($sec ne '')) {
	&devalidate_cache_new('getcourseroles',$cdom.'_'.$cnum);
	}
}	}
}	}
return;	return;
Line 2670 sub get_course_adv_roles {	Line 2721 sub get_course_adv_roles {
my ($cid,$codes) = @_;	my ($cid,$codes) = @_;
$cid=$env{'request.course.id'} unless (defined($cid));	$cid=$env{'request.course.id'} unless (defined($cid));
my %coursehash=&coursedescription($cid);	my %coursehash=&coursedescription($cid);
	my $crstype = &Apache::loncommon::course_type($cid);
my %nothide=();	my %nothide=();
foreach my $user (split(/\s\,\s/,$coursehash{'nothideprivileged'})) {	foreach my $user (split(/\s\,\s/,$coursehash{'nothideprivileged'})) {
if ($user !~ /:/) {	if ($user !~ /:/) {
Line 2682 sub get_course_adv_roles {	Line 2734 sub get_course_adv_roles {
my %dumphash=	my %dumphash=
&dump('nohist_userroles',$coursehash{'domain'},$coursehash{'num'});	&dump('nohist_userroles',$coursehash{'domain'},$coursehash{'num'});
my $now=time;	my $now=time;
foreach my $entry (keys %dumphash) {	my %privileged;
	foreach my $entry (keys(%dumphash)) {
my ($tend,$tstart)=split(/\:/,$dumphash{$entry});	my ($tend,$tstart)=split(/\:/,$dumphash{$entry});
if (($tstart) && ($tstart<0)) { next; }	if (($tstart) && ($tstart<0)) { next; }
if (($tend) && ($tend<$now)) { next; }	if (($tend) && ($tend<$now)) { next; }
if (($tstart) && ($now<$tstart)) { next; }	if (($tstart) && ($now<$tstart)) { next; }
my ($role,$username,$domain,$section)=split(/\:/,$entry);	my ($role,$username,$domain,$section)=split(/\:/,$entry);
if ($username eq '' \|\| $domain eq '') { next; }	if ($username eq '' \|\| $domain eq '') { next; }
if ((&privileged($username,$domain)) &&	unless (ref($privileged{$domain}) eq 'HASH') {
(!$nothide{$username.':'.$domain})) { next; }	my %dompersonnel =
	&Apache::lonnet::get_domain_roles($domain,['dc'],$now,$now);
	$privileged{$domain} = {};
	foreach my $server (keys(%dompersonnel)) {
	if (ref($dompersonnel{$server}) eq 'HASH') {
	foreach my $user (keys(%{$dompersonnel{$server}})) {
	my ($trole,$uname,$udom) = split(/:/,$user);
	$privileged{$udom}{$uname} = 1;
	}
	}
	}
	}
	if ((exists($privileged{$domain}{$username})) &&
	(!$nothide{$username.':'.$domain})) { next; }
if ($role eq 'cr') { next; }	if ($role eq 'cr') { next; }
if ($codes) {	if ($codes) {
if ($section) { $role .= ':'.$section; }	if ($section) { $role .= ':'.$section; }
Line 2700 sub get_course_adv_roles {	Line 2766 sub get_course_adv_roles {
$returnhash{$role}=$username.':'.$domain;	$returnhash{$role}=$username.':'.$domain;
}	}
} else {	} else {
my $key=&plaintext($role);	my $key=&plaintext($role,$crstype);
if ($section) { $key.=' ('.&Apache::lonlocal::mt('Section [_1]',$section).')'; }	if ($section) { $key.=' ('.&Apache::lonlocal::mt('Section [_1]',$section).')'; }
if ($returnhash{$key}) {	if ($returnhash{$key}) {
$returnhash{$key}.=','.$username.':'.$domain;	$returnhash{$key}.=','.$username.':'.$domain;
Line 2735 sub get_my_roles {	Line 2801 sub get_my_roles {
}	}
my %returnhash=();	my %returnhash=();
my $now=time;	my $now=time;
	my %privileged;
foreach my $entry (keys(%dumphash)) {	foreach my $entry (keys(%dumphash)) {
my ($role,$tend,$tstart);	my ($role,$tend,$tstart);
if ($context eq 'userroles') {	if ($context eq 'userroles') {
Line 2783 sub get_my_roles {	Line 2850 sub get_my_roles {
}	}
}	}
if ($hidepriv) {	if ($hidepriv) {
if ((&privileged($username,$domain)) &&	if ($context eq 'userroles') {
(!$nothide{$username.':'.$domain})) {	if ((&privileged($username,$domain)) &&
next;	(!$nothide{$username.':'.$domain})) {
	next;
	}
	} else {
	unless (ref($privileged{$domain}) eq 'HASH') {
	my %dompersonnel =
	&Apache::lonnet::get_domain_roles($domain,['dc'],$now,$now);
	$privileged{$domain} = {};
	if (keys(%dompersonnel)) {
	foreach my $server (keys(%dompersonnel)) {
	if (ref($dompersonnel{$server}) eq 'HASH') {
	foreach my $user (keys(%{$dompersonnel{$server}})) {
	my ($trole,$uname,$udom) = split(/:/,$user);
	$privileged{$udom}{$uname} = $trole;
	}
	}
	}
	}
	}
	if (exists($privileged{$domain}{$username})) {
	if (!$nothide{$username.':'.$domain}) {
	next;
	}
	}
}	}
}	}
if ($withsec) {	if ($withsec) {
Line 3355 sub tmpreset {	Line 3445 sub tmpreset {
if (tie(%hash,'GDBM_File',	if (tie(%hash,'GDBM_File',
$path.'/tmpstore_'.$stuname.'_'.$domain.'_'.$namespace.'.db',	$path.'/tmpstore_'.$stuname.'_'.$domain.'_'.$namespace.'.db',
&GDBM_WRCREAT(),0640)) {	&GDBM_WRCREAT(),0640)) {
foreach my $key (keys %hash) {	foreach my $key (keys(%hash)) {
if ($key=~ /:$symb/) {	if ($key=~ /:$symb/) {
delete($hash{$key});	delete($hash{$key});
}	}
Line 3791 sub set_userprivs {	Line 3881 sub set_userprivs {
my $adv=0;	my $adv=0;
my %grouproles = ();	my %grouproles = ();
if (keys(%{$allgroups}) > 0) {	if (keys(%{$allgroups}) > 0) {
foreach my $role (keys %{$allroles}) {	foreach my $role (keys(%{$allroles})) {
my ($trole,$area,$sec,$extendedarea);	my ($trole,$area,$sec,$extendedarea);
if ($role =~ m-^(\w+\|cr/$match_domain/$match_username/\w+)\.(/$match_domain/$match_courseid)(/?\w*)\.-) {	if ($role =~ m-^(\w+\|cr/$match_domain/$match_username/\w+)\.(/$match_domain/$match_courseid)(/?\w*)\.-) {
$trole = $1;	$trole = $1;
Line 3834 sub set_userprivs {	Line 3924 sub set_userprivs {
return ($author,$adv);	return ($author,$adv);
}	}

	sub role_status {
	my ($rolekey,$then,$now,$role,$where,$trolecode,$tstatus,$tstart,$tend) = @_;
	my @pwhere = ();
	if (exists($env{$rolekey}) && $env{$rolekey} ne '') {
	(undef,undef,$$role,@pwhere)=split(/\./,$rolekey);
	unless (!defined($$role) \|\| $$role eq '') {
	$$where=join('.',@pwhere);
	$$trolecode=$$role.'.'.$$where;
	($$tstart,$$tend)=split(/\./,$env{$rolekey});
	$$tstatus='is';
	if ($$tstart && $$tstart>$then) {
	$$tstatus='future';
	if ($$tstart<$now) { $$tstatus='will'; }
	}
	if ($$tend) {
	if ($$tend<$then) {
	$$tstatus='expired';
	} elsif ($$tend<$now) {
	$$tstatus='will_not';
	}
	}
	}
	}
	}

	sub check_adhoc_privs {
	my ($cdom,$cnum,$then,$now,$checkrole) = @_;
	my $cckey = 'user.role.'.$checkrole.'./'.$cdom.'/'.$cnum;
	if ($env{$cckey}) {
	my ($role,$where,$trolecode,$tstart,$tend,$tremark,$tstatus,$tpstart,$tpend);
	&role_status($cckey,$then,$now,\$role,\$where,\$trolecode,\$tstatus,\$tstart,\$tend);
	unless (($tstatus eq 'is') \|\| ($tstatus eq 'will_not')) {
	&set_adhoc_privileges($cdom,$cnum,$checkrole);
	}
	} else {
	&set_adhoc_privileges($cdom,$cnum,$checkrole);
	}
	}

	sub set_adhoc_privileges {
	# role can be cc or ca
	my ($dcdom,$pickedcourse,$role) = @_;
	my $area = '/'.$dcdom.'/'.$pickedcourse;
	my $spec = $role.'.'.$area;
	my %userroles = &set_arearole($role,$area,'','',$env{'user.domain'},
	$env{'user.name'});
	my %ccrole = ();
	&standard_roleprivs(\%ccrole,$role,$dcdom,$spec,$pickedcourse,$area);
	my ($author,$adv)= &set_userprivs(\%userroles,\%ccrole);
	&appenv(\%userroles,[$role,'cm']);
	&log($env{'user.domain'},$env{'user.name'},$env{'user.home'},"Role ".$role);
	&appenv( {'request.role' => $spec,
	'request.role.domain' => $dcdom,
	'request.course.sec' => ''
	}
	);
	my $tadv=0;
	if (&allowed('adv') eq 'F') { $tadv=1; }
	&appenv({'request.role.adv' => $tadv});
	}

# --------------------------------------------------------------- get interface	# --------------------------------------------------------------- get interface

sub get {	sub get {
Line 4890 sub allowed {	Line 5041 sub allowed {

my $envkey;	my $envkey;
if ($thisallowed=~/L/) {	if ($thisallowed=~/L/) {
foreach $envkey (keys %env) {	foreach $envkey (keys(%env)) {
if ($envkey=~/^user\.role\.(st\|ta)\.([^\.]*)/) {	if ($envkey=~/^user\.role\.(st\|ta)\.([^\.]*)/) {
my $courseid=$2;	my $courseid=$2;
my $roleid=$1.'.'.$2;	my $roleid=$1.'.'.$2;
Line 5181 sub fetch_enrollment_query {	Line 5332 sub fetch_enrollment_query {
}	}
my $host=&hostname($homeserver);	my $host=&hostname($homeserver);
my $cmd = '';	my $cmd = '';
foreach my $affiliate (keys %{$affiliatesref}) {	foreach my $affiliate (keys(%{$affiliatesref})) {
$cmd .= $affiliate.'='.join(",",@{$$affiliatesref{$affiliate}}).'%%';	$cmd .= $affiliate.'='.join(",",@{$$affiliatesref{$affiliate}}).'%%';
}	}
$cmd =~ s/%%$//;	$cmd =~ s/%%$//;
Line 5661 sub devalidate_getgroups_cache {	Line 5812 sub devalidate_getgroups_cache {
# ------------------------------------------------------------------ Plain Text	# ------------------------------------------------------------------ Plain Text

sub plaintext {	sub plaintext {
my ($short,$type,$cid) = @_;	my ($short,$type,$cid,$forcedefault) = @_;
if ($short =~ /^cr/) {	if ($short =~ /^cr/) {
return (split('/',$short))[-1];	return (split('/',$short))[-1];
}	}
if (!defined($cid)) {	if (!defined($cid)) {
$cid = $env{'request.course.id'};	$cid = $env{'request.course.id'};
}	}
if (defined($cid) && defined($env{'course.'.$cid.'.'.$short.'.plaintext'})) {	if (defined($cid) && ($env{'course.'.$cid.'.'.$short.'.plaintext'} ne '')) {
return &Apache::lonlocal::mt($env{'course.'.$cid.'.'.$short.	unless ($forcedefault) {
'.plaintext'});	my $roletext = $env{'course.'.$cid.'.'.$short.'.plaintext'};
	&Apache::lonlocal::mt_escape(\$roletext);
	return &Apache::lonlocal::mt($roletext);
	}
}	}
my %rolenames = (	my %rolenames = (
Course => 'std',	Course => 'std',
Line 5891 sub modifyuser {	Line 6045 sub modifyuser {
if ($email=~/\@/) { $names{'permanentemail'} = $email; }	if ($email=~/\@/) { $names{'permanentemail'} = $email; }
}	}
if ($uid) { $names{'id'} = $uid; }	if ($uid) { $names{'id'} = $uid; }
if (defined($inststatus)) { $names{'inststatus'} = $inststatus; }	if (defined($inststatus)) {
	$names{'inststatus'} = '';
	my ($usertypes,$typesorder) = &retrieve_inst_usertypes($udom);
	if (ref($usertypes) eq 'HASH') {
	my @okstatuses;
	foreach my $item (split(/:/,$inststatus)) {
	if (defined($usertypes->{$item})) {
	push(@okstatuses,$item);
	}
	}
	if (@okstatuses) {
	$names{'inststatus'} = join(':', map { &escape($_); } @okstatuses);
	}
	}
	}
my $reply = &put('environment', \%names, $udom,$uname);	my $reply = &put('environment', \%names, $udom,$uname);
if ($reply ne 'ok') { return 'error: '.$reply; }	if ($reply ne 'ok') { return 'error: '.$reply; }
my $sqlresult = &update_allusers_table($uname,$udom,\%names);	my $sqlresult = &update_allusers_table($uname,$udom,\%names);
Line 5913 sub modifyuser {	Line 6081 sub modifyuser {
sub modifystudent {	sub modifystudent {
my ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$usec,	my ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$usec,
$end,$start,$forceid,$desiredhome,$email,$type,$locktype,$cid,	$end,$start,$forceid,$desiredhome,$email,$type,$locktype,$cid,
$selfenroll,$context)=@_;	$selfenroll,$context,$inststatus)=@_;
if (!$cid) {	if (!$cid) {
unless ($cid=$env{'request.course.id'}) {	unless ($cid=$env{'request.course.id'}) {
return 'not_in_class';	return 'not_in_class';
Line 5922 sub modifystudent {	Line 6090 sub modifystudent {
# --------------------------------------------------------------- Make the user	# --------------------------------------------------------------- Make the user
my $reply=&modifyuser	my $reply=&modifyuser
($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$forceid,	($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$forceid,
$desiredhome,$email);	$desiredhome,$email,$inststatus);
unless ($reply eq 'ok') { return $reply; }	unless ($reply eq 'ok') { return $reply; }
# This will cause &modify_student_enrollment to get the uid from the	# This will cause &modify_student_enrollment to get the uid from the
# students environment	# students environment
Line 7672 sub symblist {	Line 7840 sub symblist {
if (($env{'request.course.fn'}) && (%newhash)) {	if (($env{'request.course.fn'}) && (%newhash)) {
if (tie(%hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db',	if (tie(%hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db',
&GDBM_WRCREAT(),0640)) {	&GDBM_WRCREAT(),0640)) {
foreach my $url (keys %newhash) {	foreach my $url (keys(%newhash)) {
next if ($url eq 'last_known'	next if ($url eq 'last_known'
&& $env{'form.no_update_last_known'});	&& $env{'form.no_update_last_known'});
$hash{declutter($url)}=&encode_symb($mapname,	$hash{declutter($url)}=&encode_symb($mapname,
Line 9010 sub get_dns {	Line 9178 sub get_dns {

return %iphost;	return %iphost;
}	}
}

#	#
# Given a DNS returns the loncapa host name for that DNS	# Given a DNS returns the loncapa host name for that DNS
#	#
sub host_from_dns {	sub host_from_dns {
my ($dns) = @_;	my ($dns) = @_;
my @hosts;	my @hosts;
my $ip;	my $ip;

$ip = gethostbyname($dns); # Initial translation to IP is in net order.	if (exists($name_to_ip{$dns})) {
if (length($ip) == 4) {	$ip = $name_to_ip{$dns};
$ip = &IO::Socket::inet_ntoa($ip);	}
@hosts = get_hosts_from_ip($ip);	if (!$ip) {
return $hosts[0];	$ip = gethostbyname($dns); # Initial translation to IP is in net order.
	if (length($ip) == 4) {
	$ip = &IO::Socket::inet_ntoa($ip);
	}
	}
	if ($ip) {
	@hosts = get_hosts_from_ip($ip);
	return $hosts[0];
	}
	return undef;
}	}
return undef;
}	}

BEGIN {	BEGIN {
Line 9308 in the user's environment.db and in %env	Line 9484 in the user's environment.db and in %env

=item *	=item *
X<delenv()>	X<delenv()>
B<delenv($regexp)>: removes all items from the session	B<delenv($delthis,$regexp)>: removes all items from the session
environment file that matches the regular expression in $regexp. The	environment file that begin with $delthis. If the
values are also delted from the current processes %env.	optional second arg - $regexp - is true, $delthis is treated as a
	regular expression, otherwise \Q$delthis\E is used.
	The values are also deleted from the current processes %env.

=item * get_env_multiple($name)	=item * get_env_multiple($name)

Line 9407 and course level	Line 9585 and course level

=item *	=item *

plaintext($short) : return value in %prp hash (rolesplain.tab); plain text	plaintext($short,$type,$cid,$forcedefault) : return value in %prp hash
explanation of a user role term	(rolesplain.tab); plain text explanation of a user role term.
	$type is Course (default) or Group.
	If $forcedefault evaluates to true, text returned will be default
	text for $type. Otherwise, if this is a course, the text returned
	will be a custom name for the role (if defined in the course's
	environment). If no custom name is defined the default is returned.

=item *	=item *

get_my_roles($uname,$udom,$context,$types,$roles,$roledoms,$withsec) :	get_my_roles($uname,$udom,$context,$types,$roles,$roledoms,$withsec) :

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

Removed from v.1.986
changed lines
	Added in v.1.1000