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.122 and 1.133

version 1.122, 2001/04/16 23:16:31	version 1.133, 2001/07/26 21:40:27
Line 28	Line 28
# revokecustomrole (udom,uname,url,rdom,rnam,rolename) : Revoke a custom role	# revokecustomrole (udom,uname,url,rdom,rnam,rolename) : Revoke a custom role
# appenv(hash) : adds hash to session environment	# appenv(hash) : adds hash to session environment
# delenv(varname) : deletes all environment entries starting with varname	# delenv(varname) : deletes all environment entries starting with varname
# store(hashref,symb,courseid,udom,uname,homeserver)	# store(hashref,symb,courseid,udom,uname)
# : stores hash permanently for this url	# : stores hash permanently for this url
# hashref needs to be given, and should be a \%hashname	# hashref needs to be given, and should be a \%hashname
# the remaining args aren't required and if they aren't	# the remaining args aren't required and if they aren't
# passed or are '' they will be derived from the ENV	# passed or are '' they will be derived from the ENV
# cstore(hashref,symb,courseid,udom,uname,homeserver)	# cstore(hashref,symb,courseid,udom,uname)
# : same as store but uses the critical interface to	# : same as store but uses the critical interface to
# guarentee a store	# guarentee a store
# restore(symb,courseid,udom,uname,homeserver)	# restore(symb,courseid,udom,uname)
# : returns hash for this symb, all args are optional	# : returns hash for this symb, all args are optional
# if they aren't given they will be derived from the current	# if they aren't given they will be derived from the
# enviroment	# current enviroment
# eget(namesp,array) : returns hash with keys from array filled in from namesp	#
# get(namesp,array) : returns hash with keys from array filled in from namesp	#
# del(namesp,array) : deletes keys out of array from namesp	# for the next 4 functions udom and uname are optional
	# if supplied they use udom as the domain and uname
	# as the username for the function (supply a courseid
	# for the uname if you want a course database)
	# if not supplied it uses %ENV and looks at
	# user. attribute for the values
	#
	# eget(namesp,arrayref,udom,uname)
	# : returns hash with keys from array reference filled
	# in from namesp (encrypts the return communication)
	# get(namesp,arrayref,udom,uname)
	# : returns hash with keys from array reference filled
	# in from namesp
	# dump(namesp,udom,uname) : dumps the complete namespace into a hash
	# del(namesp,array,udom,uname) : deletes keys out of array from namesp
	#
	#
# put(namesp,hash) : stores hash in namesp	# put(namesp,hash) : stores hash in namesp
# cput(namesp,hash) : critical put	# cput(namesp,hash) : critical put
# dump(namesp) : dumps the complete namespace into a hash
# ssi(url,hash) : does a complete request cycle on url to localhost, posts	# ssi(url,hash) : does a complete request cycle on url to localhost, posts
# hash	# hash
# coursedescription(id) : returns and caches course description for id	# coursedescription(id) : returns and caches course description for id
Line 102	Line 117
# 3/2 Gerd Kortemeyer	# 3/2 Gerd Kortemeyer
# 3/15,3/19 Scott Harrison	# 3/15,3/19 Scott Harrison
# 3/19,3/20 Gerd Kortemeyer	# 3/19,3/20 Gerd Kortemeyer
# 3/22,3/27 Scott Harrison	# 3/22,3/27,4/2,4/16,4/17 Scott Harrison
	# 5/26,5/28 Gerd Kortemeyer
	# 5/30 H. K. Ng
	# 6/1 Gerd Kortemeyer
	#

package Apache::lonnet;	package Apache::lonnet;

Line 664 sub devalidate {	Line 683 sub devalidate {
if ($cid) {	if ($cid) {
my $key=$ENV{'user.name'}.':'.$ENV{'user.domain'}.':';	my $key=$ENV{'user.name'}.':'.$ENV{'user.domain'}.':';
my $status=	my $status=
&reply('del:'.$ENV{'course.'.$cid.'.domain'}.':'.	&del('nohist_calculatedsheet',
$ENV{'course.'.$cid.'.num'}.	[$key.'studentcalc'],
':nohist_calculatedsheets:'.	$ENV{'course.'.$cid.'.domain'},
&escape($key.'studentcalc:'),	$ENV{'course.'.$cid.'.num'})
$ENV{'course.'.$cid.'.home'})	.' '.
.' '.	&del('nohist_calculatedsheets_'.$cid,
&reply('del:'.$ENV{'user.domain'}.':'.	[$key.'assesscalc:'.$symb]);
$ENV{'user.name'}.
':nohist_calculatedsheets_'.$cid.':'.
&escape($key.'assesscalc:'.$symb),
$ENV{'user.home'});
unless ($status eq 'ok ok') {	unless ($status eq 'ok ok') {
&logthis('Could not devalidate spreadsheet '.	&logthis('Could not devalidate spreadsheet '.
$ENV{'user.name'}.' at '.$ENV{'user.domain'}.' for '.	$ENV{'user.name'}.' at '.$ENV{'user.domain'}.' for '.
$symb.': '.$status);	$symb.': '.$status);
}	}
}	}
}	}

# ----------------------------------------------------------------------- Store	# ----------------------------------------------------------------------- Store

sub store {	sub store {
my ($storehash,$symb,$namespace,$domain,$stuname,$home) = @_;	my ($storehash,$symb,$namespace,$domain,$stuname) = @_;
	my $home='';

	if ($stuname) {
	$home=&homeserver($stuname,$domain);
	}

if (!$symb) { unless ($symb=&symbread()) { return ''; } }	if (!$symb) { unless ($symb=&symbread()) { return ''; } }

&devalidate($symb);	&devalidate($symb);
Line 701 sub store {	Line 722 sub store {
$namevalue.=escape($_).'='.escape($$storehash{$_}).'&';	$namevalue.=escape($_).'='.escape($$storehash{$_}).'&';
} keys %$storehash;	} keys %$storehash;
$namevalue=~s/\&$//;	$namevalue=~s/\&$//;
return critical("store:$domain:$stuname:$namespace:$symb:$namevalue","$home");	return reply("store:$domain:$stuname:$namespace:$symb:$namevalue","$home");
}	}

# -------------------------------------------------------------- Critical Store	# -------------------------------------------------------------- Critical Store

sub cstore {	sub cstore {
my ($storehash,$symb,$namespace,$domain,$stuname,$home) = @_;	my ($storehash,$symb,$namespace,$domain,$stuname) = @_;
	my $home='';

	if ($stuname) {
	$home=&homeserver($stuname,$domain);
	}

if (!$symb) { unless ($symb=&symbread()) { return ''; } }	if (!$symb) { unless ($symb=&symbread()) { return ''; } }

&devalidate($symb);	&devalidate($symb);
Line 729 sub cstore {	Line 756 sub cstore {
# --------------------------------------------------------------------- Restore	# --------------------------------------------------------------------- Restore

sub restore {	sub restore {
my ($symb,$namespace,$domain,$stuname,$home) = @_;	my ($symb,$namespace,$domain,$stuname) = @_;
	my $home='';

	if ($stuname) {
	$home=&homeserver($stuname,$domain);
	}

if (!$symb) {	if (!$symb) {
unless ($symb=escape(&symbread())) { return ''; }	unless ($symb=escape(&symbread())) { return ''; }
} else {	} else {
Line 762 sub coursedescription {	Line 795 sub coursedescription {
$courseid=~s/^\///;	$courseid=~s/^\///;
$courseid=~s/\_/\//g;	$courseid=~s/\_/\//g;
my ($cdomain,$cnum)=split(/\//,$courseid);	my ($cdomain,$cnum)=split(/\//,$courseid);
my $chome=homeserver($cnum,$cdomain);	my $chome=&homeserver($cnum,$cdomain);
if ($chome ne 'no_host') {	if ($chome ne 'no_host') {
my $rep=reply("dump:$cdomain:$cnum:environment",$chome);	my %returnhash=&dump('environment',$cdomain,$cnum);
if ($rep ne 'con_lost') {	if (!exists($returnhash{'con_lost'})) {
my $normalid=$cdomain.'_'.$cnum;	my $normalid=$cdomain.'_'.$cnum;
my %envhash=();	my %envhash=();
my %returnhash=('home' => $chome,	$returnhash{'home'}= $chome;
'domain' => $cdomain,	$returnhash{'domain'} = $cdomain;
'num' => $cnum);	$returnhash{'num'} = $cnum;
map {	while (my ($name,$value) = each %returnhash) {
my ($name,$value)=split(/\=/,$_);
$name=&unescape($name);
$value=&unescape($value);
$returnhash{$name}=$value;
$envhash{'course.'.$normalid.'.'.$name}=$value;	$envhash{'course.'.$normalid.'.'.$name}=$value;
} split(/\&/,$rep);	}
$returnhash{'url'}='/res/'.declutter($returnhash{'url'});	$returnhash{'url'}='/res/'.declutter($returnhash{'url'});
$returnhash{'fn'}=$perlvar{'lonDaemons'}.'/tmp/'.	$returnhash{'fn'}=$perlvar{'lonDaemons'}.'/tmp/'.
$ENV{'user.name'}.'_'.$cdomain.'_'.$cnum;	$ENV{'user.name'}.'_'.$cdomain.'_'.$cnum;
Line 862 sub rolesinit {	Line 891 sub rolesinit {
}	}
}	}
} split(/&/,$rolesdump);	} split(/&/,$rolesdump);
	my $adv=0;
	my $author=0;
map {	map {
%thesepriv=();	%thesepriv=();
	if ($_!~/^st/) { $adv=1; }
	if (($_=~/^au/) \|\| ($_=~/^ca/)) { $author=1; }
map {	map {
if ($_ ne '') {	if ($_ ne '') {
my ($privilege,$restrictions)=split(/&/,$_);	my ($privilege,$restrictions)=split(/&/,$_);
Line 880 sub rolesinit {	Line 913 sub rolesinit {
map { $thesestr.=':'.$_.'&'.$thesepriv{$_}; } keys %thesepriv;	map { $thesestr.=':'.$_.'&'.$thesepriv{$_}; } keys %thesepriv;
$userroles.='user.priv.'.$_.'='.$thesestr."\n";	$userroles.='user.priv.'.$_.'='.$thesestr."\n";
} keys %allroles;	} keys %allroles;
	$userroles.='user.adv='.$adv."\n".
	'user.author='.$author."\n";
	$ENV{'user.adv'}=$adv;
}	}
return $userroles;	return $userroles;
}	}
Line 887 sub rolesinit {	Line 923 sub rolesinit {
# --------------------------------------------------------------- get interface	# --------------------------------------------------------------- get interface

sub get {	sub get {
my ($namespace,@storearr)=@_;	my ($namespace,$storearr,$udomain,$uname)=@_;
my $items='';	my $items='';
map {	map {
$items.=escape($_).'&';	$items.=escape($_).'&';
} @storearr;	} @$storearr;
$items=~s/\&$//;	$items=~s/\&$//;
my $rep=reply("get:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$items",	if (!$udomain) { $udomain=$ENV{'user.domain'}; }
$ENV{'user.home'});	if (!$uname) { $uname=$ENV{'user.name'}; }
	my $uhome=&homeserver($uname,$udomain);

	my $rep=&reply("get:$udomain:$uname:$namespace:$items",$uhome);
my @pairs=split(/\&/,$rep);	my @pairs=split(/\&/,$rep);
my %returnhash=();	my %returnhash=();
my $i=0;	my $i=0;
map {	map {
$returnhash{$_}=unescape($pairs[$i]);	$returnhash{$_}=unescape($pairs[$i]);
$i++;	$i++;
} @storearr;	} @$storearr;
return %returnhash;	return %returnhash;
}	}

# --------------------------------------------------------------- del interface	# --------------------------------------------------------------- del interface

sub del {	sub del {
my ($namespace,@storearr)=@_;	my ($namespace,$storearr,$udomain,$uname)=@_;
my $items='';	my $items='';
map {	map {
$items.=escape($_).'&';	$items.=escape($_).'&';
} @storearr;	} @$storearr;
$items=~s/\&$//;	$items=~s/\&$//;
return reply("del:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$items",	if (!$udomain) { $udomain=$ENV{'user.domain'}; }
$ENV{'user.home'});	if (!$uname) { $uname=$ENV{'user.name'}; }
	my $uhome=&homeserver($uname,$udomain);

	return &reply("del:$udomain:$uname:$namespace:$items",$uhome);
}	}

# -------------------------------------------------------------- dump interface	# -------------------------------------------------------------- dump interface

sub dump {	sub dump {
my $namespace=shift;	my ($namespace,$udomain,$uname)=@_;
my $rep=reply("dump:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace",	if (!$udomain) { $udomain=$ENV{'user.domain'}; }
$ENV{'user.home'});	if (!$uname) { $uname=$ENV{'user.name'}; }
	my $uhome=&homeserver($uname,$udomain);
	my $rep=reply("dump:$udomain:$uname:$namespace",$uhome);
my @pairs=split(/\&/,$rep);	my @pairs=split(/\&/,$rep);
my %returnhash=();	my %returnhash=();
map {	map {
Line 963 sub cput {	Line 1007 sub cput {
# -------------------------------------------------------------- eget interface	# -------------------------------------------------------------- eget interface

sub eget {	sub eget {
my ($namespace,@storearr)=@_;	my ($namespace,$storearr,$udomain,$uname)=@_;
my $items='';	my $items='';
map {	map {
$items.=escape($_).'&';	$items.=escape($_).'&';
} @storearr;	} @$storearr;
$items=~s/\&$//;	$items=~s/\&$//;
my $rep=reply("eget:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$items",	if (!$udomain) { $udomain=$ENV{'user.domain'}; }
$ENV{'user.home'});	if (!$uname) { $uname=$ENV{'user.name'}; }
	my $uhome=&homeserver($uname,$udomain);
	my $rep=&reply("eget:$udomain:$uname:$namespace:$items",$uhome);
my @pairs=split(/\&/,$rep);	my @pairs=split(/\&/,$rep);
my %returnhash=();	my %returnhash=();
my $i=0;	my $i=0;
map {	map {
$returnhash{$_}=unescape($pairs[$i]);	$returnhash{$_}=unescape($pairs[$i]);
$i++;	$i++;
} @storearr;	} @$storearr;
return %returnhash;	return %returnhash;
}	}

Line 1259 sub metadata_query {	Line 1305 sub metadata_query {
my ($query,$custom,$customshow)=@_;	my ($query,$custom,$customshow)=@_;
# need to put in a library server loop here and return a hash	# need to put in a library server loop here and return a hash
my %rhash;	my %rhash;
# for my $server (keys %libserv) {	for my $server (keys %libserv) {
for my $server ('msul3') {
unless ($custom or $customshow) {	unless ($custom or $customshow) {
my $reply=&reply("querysend:".&escape($query),$server);	my $reply=&reply("querysend:".&escape($query),$server);
$rhash{$server}=$reply;	$rhash{$server}=$reply;
Line 1676 sub EXT {	Line 1721 sub EXT {
# ---------------------------------------------------- Any other user namespace	# ---------------------------------------------------- Any other user namespace
} else {	} else {
my $item=($rest)?$qualifier.'.'.$rest:$qualifier;	my $item=($rest)?$qualifier.'.'.$rest:$qualifier;
my %reply=&get($space,$item);	my %reply=&get($space,[$item]);
return $reply{$item};	return $reply{$item};
}	}
} elsif ($realm eq 'request') {	} elsif ($realm eq 'request') {
Line 1689 sub EXT {	Line 1734 sub EXT {
}	}
} elsif ($realm eq 'course') {	} elsif ($realm eq 'course') {
# ---------------------------------------------------------- course.description	# ---------------------------------------------------------- course.description
my $section='';	return $ENV{'course.'.$ENV{'request.course.id'}.'.'.
if ($ENV{'request.course.sec'}) {
$section='_'.$ENV{'request.course.sec'};
}
return $ENV{'course.'.$ENV{'request.course.id'}.$section.'.'.
$spacequalifierrest};	$spacequalifierrest};
} elsif ($realm eq 'resource') {	} elsif ($realm eq 'resource') {
if ($ENV{'request.course.id'}) {	if ($ENV{'request.course.id'}) {
# ----------------------------------------------------- Cascading lookup scheme	# ----------------------------------------------------- Cascading lookup scheme
my $symbp=&symbread();	my $symbp=&symbread();
my $mapp=(split(/\_\_\_/,$symbp))[0];	my $mapp=(split(/\_\_\_/,$symbp))[0];

my $symbparm=$symbp.'.'.$spacequalifierrest;	my $symbparm=$symbp.'.'.$spacequalifierrest;
my $mapparm=$mapp.'___(all).'.$spacequalifierrest;	my $mapparm=$mapp.'___(all).'.$spacequalifierrest;

my $seclevel=	my $seclevel=
$ENV{'request.course.id'}.'.['.	$ENV{'request.course.id'}.'.['.
$ENV{'request.course.sec'}.'].'.$spacequalifierrest;	$ENV{'request.course.sec'}.'].'.$spacequalifierrest;
my $seclevelr=	my $seclevelr=
$ENV{'request.course.id'}.'.['.	$ENV{'request.course.id'}.'.['.
$ENV{'request.course.sec'}.'].'.$symbparm;	$ENV{'request.course.sec'}.'].'.$symbparm;
my $seclevelm=	my $seclevelm=
$ENV{'request.course.id'}.'.['.	$ENV{'request.course.id'}.'.['.
$ENV{'request.course.sec'}.'].'.$mapparm;	$ENV{'request.course.sec'}.'].'.$mapparm;

my $courselevel=	my $courselevel=
$ENV{'request.course.id'}.'.'.$spacequalifierrest;	$ENV{'request.course.id'}.'.'.$spacequalifierrest;
my $courselevelr=	my $courselevelr=
$ENV{'request.course.id'}.'.'.$symbparm;	$ENV{'request.course.id'}.'.'.$symbparm;
my $courselevelm=	my $courselevelm=
$ENV{'request.course.id'}.'.'.$mapparm;	$ENV{'request.course.id'}.'.'.$mapparm;

# ----------------------------------------------------------- first, check user	# ----------------------------------------------------------- first, check user
my %resourcedata=get('resourcedata',	my %resourcedata=get('resourcedata',
($courselevelr,$courselevelm,$courselevel));	[$courselevelr,$courselevelm,$courselevel]);
if (($resourcedata{$courselevelr}!~/^error\:/) &&	if (($resourcedata{$courselevelr}!~/^error\:/) &&
($resourcedata{$courselevelr}!~/^con_lost/)) {	($resourcedata{$courselevelr}!~/^con_lost/)) {

if ($resourcedata{$courselevelr}) {	if ($resourcedata{$courselevelr}) {
return $resourcedata{$courselevelr}; }	return $resourcedata{$courselevelr}; }
if ($resourcedata{$courselevelm}) {	if ($resourcedata{$courselevelm}) {
return $resourcedata{$courselevelm}; }	return $resourcedata{$courselevelm}; }
if ($resourcedata{$courselevel}) { return $resourcedata{$courselevel}; }	if ($resourcedata{$courselevel}) { return $resourcedata{$courselevel}; }

} else {	} else {
if ($resourcedata{$courselevelr}!~/No such file/) {	if ($resourcedata{$courselevelr}!~/No such file/) {
Line 1789 sub EXT {	Line 1830 sub EXT {
# ---------------------------------------------------- Any other user namespace	# ---------------------------------------------------- Any other user namespace
} elsif ($realm eq 'environment') {	} elsif ($realm eq 'environment') {
# ----------------------------------------------------------------- environment	# ----------------------------------------------------------------- environment
return $ENV{$spacequalifierrest};	return $ENV{'environment.'.$spacequalifierrest};
} elsif ($realm eq 'system') {	} elsif ($realm eq 'system') {
# ----------------------------------------------------------------- system.time	# ----------------------------------------------------------------- system.time
if ($space eq 'time') {	if ($space eq 'time') {

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

Removed from v.1.122
changed lines
	Added in v.1.133