version 1.259, 2002/08/01 15:26:23
|
version 1.267, 2002/08/13 14:37:52
|
Line 608 sub userenvironment {
|
Line 608 sub userenvironment {
|
return %returnhash; |
return %returnhash; |
} |
} |
|
|
|
# -------------------------------------------------------------------- New chat |
|
|
|
sub chatsend { |
|
my ($newentry,$anon)=@_; |
|
my $cnum=$ENV{'course.'.$ENV{'request.course.id'}.'.num'}; |
|
my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}; |
|
my $chome=$ENV{'course.'.$ENV{'request.course.id'}.'.home'}; |
|
&reply('chatsend:'.$cdom.':'.$cnum.':'. |
|
&escape($ENV{'user.domain'}.':'.$ENV{'user.name'}.':'.$anon.':'. |
|
&escape($newentry)),$chome); |
|
} |
|
|
# ----------------------------- Subscribe to a resource, return URL if possible |
# ----------------------------- Subscribe to a resource, return URL if possible |
|
|
sub subscribe { |
sub subscribe { |
Line 766 sub userfileupload {
|
Line 778 sub userfileupload {
|
} |
} |
# Notify homeserver to grep it |
# Notify homeserver to grep it |
# |
# |
# FIXME - this still needs to happen |
if |
|
(&reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$fname,$docuhome) eq 'ok') |
|
{ |
# |
# |
# Return the URL to it |
# Return the URL to it |
return '/uploaded/'.$path.$fname; |
return '/uploaded/'.$path.$fname; |
|
} else { |
|
return '/adm/notfound.html'; |
|
} |
} |
} |
|
|
# ------------------------------------------------------------------------- Log |
# ------------------------------------------------------------------------- Log |
Line 803 sub flushcourselogs {
|
Line 820 sub flushcourselogs {
|
my $entry=$_; |
my $entry=$_; |
$entry=~/\_\_\_(\w+)\/(\w+)\/(.*)\_\_\_(\w+)$/; |
$entry=~/\_\_\_(\w+)\/(\w+)\/(.*)\_\_\_(\w+)$/; |
my %temphash=($entry => $accesshash{$entry}); |
my %temphash=($entry => $accesshash{$entry}); |
if (&Apache::lonnet::put('resevaldata',\%temphash,$1,$2) eq 'ok') { |
if (&Apache::lonnet::put('nohist_resevaldata',\%temphash,$1,$2) eq 'ok') { |
delete $accesshash{$entry}; |
delete $accesshash{$entry}; |
} |
} |
} |
} |
Line 983 sub devalidate {
|
Line 1000 sub devalidate {
|
} |
} |
} |
} |
|
|
|
sub get_scalar { |
|
my ($string,$end) = @_; |
|
my $value; |
|
if ($$string =~ s/^([^&]*?)($end)/$2/) { |
|
$value = $1; |
|
} elsif ($$string =~ s/^([^&]*?)&//) { |
|
$value = $1; |
|
} |
|
return &unescape($value); |
|
} |
|
|
|
sub array2str { |
|
my (@array) = @_; |
|
my $result=&arrayref2str(\@array); |
|
$result=~s/^__ARRAY_REF__//; |
|
$result=~s/__END_ARRAY_REF__$//; |
|
return $result; |
|
} |
|
|
sub arrayref2str { |
sub arrayref2str { |
my ($arrayref) = @_; |
my ($arrayref) = @_; |
my $result='_ARRAY_REF__'; |
my $result='__ARRAY_REF__'; |
foreach my $elem (@$arrayref) { |
foreach my $elem (@$arrayref) { |
if (ref($elem) eq 'ARRAY') { |
if(ref($elem) eq 'ARRAY') { |
$result.=&escape(&arrayref2str($elem)).'&'; |
$result.=&arrayref2str($elem).'&'; |
} elsif (ref($elem) eq 'HASH') { |
} elsif(ref($elem) eq 'HASH') { |
$result.=&escape(&hashref2str($elem)).'&'; |
$result.=&hashref2str($elem).'&'; |
} elsif (ref($elem)) { |
} elsif(ref($elem)) { |
&logthis("Got a ref of ".(ref($elem))." skipping."); |
#print("Got a ref of ".(ref($elem))." skipping."); |
} else { |
} else { |
$result.=&escape($elem).'&'; |
$result.=&escape($elem).'&'; |
} |
} |
} |
} |
$result=~s/\&$//; |
$result=~s/\&$//; |
|
$result .= '__END_ARRAY_REF__'; |
return $result; |
return $result; |
} |
} |
|
|
sub hash2str { |
sub hash2str { |
my (%hash) = @_; |
my (%hash) = @_; |
my $result=&hashref2str(\%hash); |
my $result=&hashref2str(\%hash); |
$result=~s/^_HASH_REF__//; |
$result=~s/^__HASH_REF__//; |
|
$result=~s/__END_HASH_REF__$//; |
return $result; |
return $result; |
} |
} |
|
|
sub hashref2str { |
sub hashref2str { |
my ($hashref)=@_; |
my ($hashref)=@_; |
my $result='_HASH_REF__'; |
my $result='__HASH_REF__'; |
foreach (keys(%$hashref)) { |
foreach (keys(%$hashref)) { |
if (ref($_) eq 'ARRAY') { |
if (ref($_) eq 'ARRAY') { |
$result.=&escape(&arrayref2str($_)).'='; |
$result.=&arrayref2str($_).'='; |
} elsif (ref($_) eq 'HASH') { |
} elsif (ref($_) eq 'HASH') { |
$result.=&escape(&hashref2str($_)).'='; |
$result.=&hashref2str($_).'='; |
} elsif (ref($_)) { |
} elsif (ref($_)) { |
&logthis("Got a ref of ".(ref($_))." skipping."); |
$result.='='; |
|
#print("Got a ref of ".(ref($_))." skipping."); |
} else { |
} else { |
$result.=&escape($_).'='; |
if ($_) {$result.=&escape($_).'=';} else { last; } |
} |
} |
|
|
if (ref($$hashref{$_}) eq 'ARRAY') { |
if(ref($hashref->{$_}) eq 'ARRAY') { |
$result.=&escape(&arrayref2str($$hashref{$_})).'&'; |
$result.=&arrayref2str($hashref->{$_}).'&'; |
} elsif (ref($$hashref{$_}) eq 'HASH') { |
} elsif(ref($hashref->{$_}) eq 'HASH') { |
$result.=&escape(&hashref2str($$hashref{$_})).'&'; |
$result.=&hashref2str($hashref->{$_}).'&'; |
} elsif (ref($$hashref{$_})) { |
} elsif(ref($hashref->{$_})) { |
&logthis("Got a ref of ".(ref($$hashref{$_}))." skipping."); |
$result.='&'; |
|
#print("Got a ref of ".(ref($hashref->{$_}))." skipping."); |
} else { |
} else { |
$result.=&escape($$hashref{$_}).'&'; |
$result.=&escape($hashref->{$_}).'&'; |
} |
} |
} |
} |
$result=~s/\&$//; |
$result=~s/\&$//; |
|
$result .= '__END_HASH_REF__'; |
return $result; |
return $result; |
} |
} |
|
|
sub str2hash { |
sub str2hash { |
|
my ($string)=@_; |
|
my ($hash)=&str2hashref('__HASH_REF__'.$string.'__END_HASH_REF__'); |
|
return %$hash; |
|
} |
|
|
|
sub str2hashref { |
my ($string) = @_; |
my ($string) = @_; |
my %returnhash; |
|
foreach (split(/\&/,$string)) { |
my %hash; |
my ($name,$value)=split(/\=/,$_); |
|
$name=&unescape($name); |
if($string !~ /^__HASH_REF__/) { |
$value=&unescape($value); |
if (! ($string eq '' || !defined($string))) { |
if ($value =~ /^_HASH_REF__/) { |
$hash{'error'}='Not hash reference'; |
$value =~ s/^_HASH_REF__//; |
} |
my %hash=&str2hash($value); |
return (\%hash, $string); |
$value=\%hash; |
} |
} elsif ($value =~ /^_ARRAY_REF__/) { |
|
$value =~ s/^_ARRAY_REF__//; |
$string =~ s/^__HASH_REF__//; |
my @array=&str2array($value); |
|
$value=\@array; |
while($string !~ /^__END_HASH_REF__/) { |
} |
#key |
$returnhash{$name}=$value; |
my $key=''; |
|
if($string =~ /^__HASH_REF__/) { |
|
($key, $string)=&str2hashref($string); |
|
if(defined($key->{'error'})) { |
|
$hash{'error'}='Bad data'; |
|
return (\%hash, $string); |
|
} |
|
} elsif($string =~ /^__ARRAY_REF__/) { |
|
($key, $string)=&str2arrayref($string); |
|
if($key->[0] eq 'Array reference error') { |
|
$hash{'error'}='Bad data'; |
|
return (\%hash, $string); |
|
} |
|
} else { |
|
$string =~ s/^(.*?)=//; |
|
$key=&unescape($1); |
|
} |
|
$string =~ s/^=//; |
|
|
|
#value |
|
my $value=''; |
|
if($string =~ /^__HASH_REF__/) { |
|
($value, $string)=&str2hashref($string); |
|
if(defined($value->{'error'})) { |
|
$hash{'error'}='Bad data'; |
|
return (\%hash, $string); |
|
} |
|
} elsif($string =~ /^__ARRAY_REF__/) { |
|
($value, $string)=&str2arrayref($string); |
|
if($value->[0] eq 'Array reference error') { |
|
$hash{'error'}='Bad data'; |
|
return (\%hash, $string); |
|
} |
|
} else { |
|
$value=&get_scalar(\$string,'__END_HASH_REF__'); |
|
} |
|
$string =~ s/^&//; |
|
|
|
$hash{$key}=$value; |
} |
} |
return (%returnhash); |
|
|
$string =~ s/^__END_HASH_REF__//; |
|
|
|
return (\%hash, $string); |
} |
} |
|
|
sub str2array { |
sub str2array { |
|
my ($string)=@_; |
|
my ($array)=&str2arrayref('__ARRAY_REF__'.$string.'__END_ARRAY_REF__'); |
|
return @$array; |
|
} |
|
|
|
sub str2arrayref { |
my ($string) = @_; |
my ($string) = @_; |
my @returnarray; |
my @array; |
foreach my $value (split(/\&/,$string)) { |
|
$value=&unescape($value); |
if($string !~ /^__ARRAY_REF__/) { |
if ($value =~ /^_HASH_REF__/) { |
if (! ($string eq '' || !defined($string))) { |
$value =~ s/^_HASH_REF__//; |
$array[0]='Array reference error'; |
my %hash=&str2hash($value); |
} |
$value=\%hash; |
return (\@array, $string); |
} elsif ($value =~ /^_ARRAY_REF__/) { |
} |
$value =~ s/^_ARRAY_REF__//; |
|
my @array=&str2array($value); |
$string =~ s/^__ARRAY_REF__//; |
$value=\@array; |
|
} |
while($string !~ /^__END_ARRAY_REF__/) { |
push(@returnarray,$value); |
my $value=''; |
|
if($string =~ /^__HASH_REF__/) { |
|
($value, $string)=&str2hashref($string); |
|
if(defined($value->{'error'})) { |
|
$array[0] ='Array reference error'; |
|
return (\@array, $string); |
|
} |
|
} elsif($string =~ /^__ARRAY_REF__/) { |
|
($value, $string)=&str2arrayref($string); |
|
if($value->[0] eq 'Array reference error') { |
|
$array[0] ='Array reference error'; |
|
return (\@array, $string); |
|
} |
|
} else { |
|
$value=&get_scalar(\$string,'__END_ARRAY_REF__'); |
|
} |
|
$string =~ s/^&//; |
|
|
|
push(@array, $value); |
} |
} |
return (@returnarray); |
|
|
$string =~ s/^__END_ARRAY_REF__//; |
|
|
|
return (\@array, $string); |
} |
} |
|
|
# -------------------------------------------------------------------Temp Store |
# -------------------------------------------------------------------Temp Store |
Line 1580 sub allowed {
|
Line 1695 sub allowed {
|
return ''; |
return ''; |
} |
} |
} |
} |
|
if ($ENV{'request.role'}=~ /li\.\//) { |
|
# Library role, so allow browsing of resources in this domain. |
|
return 'F'; |
|
} |
|
} |
|
# Domain coordinator is trying to create a course |
|
if (($priv eq 'ccc') && ($ENV{'request.role'} =~ /^dc\./)) { |
|
# uri is the requested domain in this case. |
|
# comparison to 'request.role.domain' shows if the user has selected |
|
# a role of dc for the domain in question. |
|
return 'F' if ($uri eq $ENV{'request.role.domain'}); |
} |
} |
|
|
my $thisallowed=''; |
my $thisallowed=''; |
Line 2167 sub writecoursepref {
|
Line 2293 sub writecoursepref {
|
# ---------------------------------------------------------- Make/modify course |
# ---------------------------------------------------------- Make/modify course |
|
|
sub createcourse { |
sub createcourse { |
my ($udom,$description,$url)=@_; |
my ($udom,$description,$url,$course_server)=@_; |
$url=&declutter($url); |
$url=&declutter($url); |
my $cid=''; |
my $cid=''; |
unless (&allowed('ccc',$ENV{'user.domain'})) { |
unless (&allowed('ccc',$udom)) { |
return 'refused'; |
|
} |
|
unless ($udom eq $ENV{'user.domain'}) { |
|
return 'refused'; |
return 'refused'; |
} |
} |
# ------------------------------------------------------------------- Create ID |
# ------------------------------------------------------------------- Create ID |
Line 2189 sub createcourse {
|
Line 2312 sub createcourse {
|
return 'error: unable to generate unique course-ID'; |
return 'error: unable to generate unique course-ID'; |
} |
} |
} |
} |
|
# ------------------------------------------------ Check supplied server name |
|
$course_server = $ENV{'user.homeserver'} if (! defined($course_server)); |
|
if (! exists($libserv{$course_server})) { |
|
return 'error:bad server name '.$course_server; |
|
} |
# ------------------------------------------------------------- Make the course |
# ------------------------------------------------------------- Make the course |
my $reply=&reply('encrypt:makeuser:'.$udom.':'.$uname.':none::', |
my $reply=&reply('encrypt:makeuser:'.$udom.':'.$uname.':none::', |
$ENV{'user.home'}); |
$course_server); |
unless ($reply eq 'ok') { return 'error: '.$reply; } |
unless ($reply eq 'ok') { return 'error: '.$reply; } |
$uhome=&homeserver($uname,$udom,'true'); |
$uhome=&homeserver($uname,$udom,'true'); |
if (($uhome eq '') || ($uhome eq 'no_host')) { |
if (($uhome eq '') || ($uhome eq 'no_host')) { |
Line 2703 sub metadata {
|
Line 2831 sub metadata {
|
# the next is the end of "start tag" |
# the next is the end of "start tag" |
} |
} |
} |
} |
|
&metadata_generate_part0(\%metathesekeys,\%metacache,$uri); |
$metacache{$uri.':keys'}=join(',',keys %metathesekeys); |
$metacache{$uri.':keys'}=join(',',keys %metathesekeys); |
$metacache{$uri.':cachedtimestamp'}=time; |
$metacache{$uri.':cachedtimestamp'}=time; |
# this is the end of "was not already recently cached |
# this is the end of "was not already recently cached |
Line 2710 sub metadata {
|
Line 2839 sub metadata {
|
return $metacache{$uri.':'.$what}; |
return $metacache{$uri.':'.$what}; |
} |
} |
|
|
|
sub metadata_generate_part0 { |
|
my ($metadata,$metacache,$uri) = @_; |
|
my %allnames; |
|
foreach my $metakey (sort keys %$metadata) { |
|
if ($metakey=~/^parameter\_(.*)/) { |
|
my $part=$$metacache{$uri.':'.$metakey.'.part'}; |
|
my $name=$$metacache{$uri.':'.$metakey.'.name'}; |
|
if (! exists($$metadata{'parameter_0_'.$name})) { |
|
$allnames{$name}=$part; |
|
} |
|
} |
|
} |
|
foreach my $name (keys(%allnames)) { |
|
$$metadata{"parameter_0_$name"}=1; |
|
my $key="$uri:parameter_0_$name"; |
|
$$metacache{"$key.part"}='0'; |
|
$$metacache{"$key.name"}=$name; |
|
$$metacache{"$key.type"}=$$metacache{$uri.':parameter_'. |
|
$allnames{$name}.'_'.$name. |
|
'.type'}; |
|
my $olddis=$$metacache{$uri.':parameter_'.$allnames{$name}.'_'.$name. |
|
'.display'}; |
|
my $expr='\\[Part: '.$allnames{$name}.'\\]'; |
|
$olddis=~s/$expr/\[Part: 0\]/; |
|
$$metacache{"$key.display"}=$olddis; |
|
} |
|
} |
|
|
# ------------------------------------------------- Update symbolic store links |
# ------------------------------------------------- Update symbolic store links |
|
|
sub symblist { |
sub symblist { |
Line 2918 sub ireceipt {
|
Line 3075 sub ireceipt {
|
} |
} |
|
|
sub receipt { |
sub receipt { |
return &ireceipt($ENV{'user.name'},$ENV{'user.domain'}, |
my ($symb,$courseid,$domain,$name) = &Apache::lonxml::whichuser(); |
$ENV{'request.course.id'},&symbread()); |
return &ireceipt($name,$domain,$courseid,$symb); |
} |
} |
|
|
# ------------------------------------------------------------ Serves up a file |
# ------------------------------------------------------------ Serves up a file |
# returns either the contents of the file or a -1 |
# returns either the contents of the file or a -1 |
sub getfile { |
sub getfile { |