version 1.316, 2003/01/10 20:55:44
|
version 1.321, 2003/01/31 22:12:13
|
Line 864 sub userfileupload {
|
Line 864 sub userfileupload {
|
# Replace spaces by underscores |
# Replace spaces by underscores |
$fname=~s/\s+/\_/g; |
$fname=~s/\s+/\_/g; |
# Replace all other weird characters by nothing |
# Replace all other weird characters by nothing |
$fname=~s/[^\w\.\-\+]//g; |
$fname=~s/[^\w\.\-]//g; |
# See if there is anything left |
# See if there is anything left |
unless ($fname) { return 'error: no uploaded file'; } |
unless ($fname) { return 'error: no uploaded file'; } |
chop($ENV{'form.'.$formname}); |
chop($ENV{'form.'.$formname}); |
Line 1744 sub dump {
|
Line 1744 sub dump {
|
return %returnhash; |
return %returnhash; |
} |
} |
|
|
|
# --------------------------------------------------------------- currentdump |
|
sub currentdump { |
|
my ($namespace,$udomain,$uname)=@_; |
|
if (!$udomain) { $udomain = $ENV{'user.domain'}; } |
|
if (!$uname) { $uname = $ENV{'user.name'}; } |
|
my $uhome = &homeserver($uname,$udomain); |
|
my $rep=reply("currentdump:$udomain:$uname:$namespace",$uhome); |
|
return if ($rep =~ /^(error:|no_such_host)/); |
|
# |
|
my %returnhash=(); |
|
# |
|
if ($rep eq "unknown_cmd") { |
|
# an old lond will not know currentdump |
|
# Do a dump and make it look like a currentdump |
|
my @tmp = &dump($namespace,$udomain,$uname,'.'); |
|
return if ($tmp[0] =~ /^(error:|no_such_host)/); |
|
my %hash = @tmp; |
|
@tmp=(); |
|
# Code ripped from lond, essentially. The only difference |
|
# here is the unescaping done by lonnet::dump(). Conceivably |
|
# we might run in to problems with parameter names =~ /^v\./ |
|
while (my ($key,$value) = each(%hash)) { |
|
my ($v,$symb,$param) = split(/:/,$key); |
|
next if ($v eq 'version' || $symb eq 'keys'); |
|
next if (exists($returnhash{$symb}) && |
|
exists($returnhash{$symb}->{$param}) && |
|
$returnhash{$symb}->{'v.'.$param} > $v); |
|
$returnhash{$symb}->{$param}=$value; |
|
$returnhash{$symb}->{'v.'.$param}=$v; |
|
} |
|
# |
|
# Remove all of the keys in the hashes which keep track of |
|
# the version of the parameter. |
|
while (my ($symb,$param_hash) = each(%returnhash)) { |
|
# use a foreach because we are going to delete from the hash. |
|
foreach my $key (keys(%$param_hash)) { |
|
delete($param_hash->{$key}) if ($key =~ /^v\./); |
|
} |
|
} |
|
} else { |
|
my @pairs=split(/\&/,$rep); |
|
foreach (@pairs) { |
|
my ($key,$value)=split(/=/,$_); |
|
my ($symb,$param) = split(/:/,$key); |
|
$returnhash{&unescape($symb)}->{&unescape($param)} = |
|
&unescape($value); |
|
} |
|
} |
|
return %returnhash; |
|
} |
|
|
# --------------------------------------------------------------- put interface |
# --------------------------------------------------------------- put interface |
|
|
sub put { |
sub put { |
Line 2766 sub EXT {
|
Line 2817 sub EXT {
|
} else { |
} else { |
$courseid=$ENV{'request.course.id'}; |
$courseid=$ENV{'request.course.id'}; |
} |
} |
|
|
my ($realm,$space,$qualifier,@therest)=split(/\./,$varname); |
my ($realm,$space,$qualifier,@therest)=split(/\./,$varname); |
my $rest; |
my $rest; |
if ($therest[0]) { |
if (defined($therest[0])) { |
$rest=join('.',@therest); |
$rest=join('.',@therest); |
} else { |
} else { |
$rest=''; |
$rest=''; |
} |
} |
|
|
my $qualifierrest=$qualifier; |
my $qualifierrest=$qualifier; |
if ($rest) { $qualifierrest.='.'.$rest; } |
if ($rest) { $qualifierrest.='.'.$rest; } |
my $spacequalifierrest=$space; |
my $spacequalifierrest=$space; |
Line 3086 sub metadata {
|
Line 3137 sub metadata {
|
foreach (@{$token->[3]}) { |
foreach (@{$token->[3]}) { |
$metacache{$uri.':'.$unikey.'.'.$_}=$token->[2]->{$_}; |
$metacache{$uri.':'.$unikey.'.'.$_}=$token->[2]->{$_}; |
} |
} |
unless ( |
my $internaltext=&HTML::Entities::decode($parser->get_text('/'.$entry)); |
$metacache{$uri.':'.$unikey}=&HTML::Entities::decode($parser->get_text('/'.$entry)) |
my $default=$metacache{$uri.':'.$unikey.'.default'}; |
) { $metacache{$uri.':'.$unikey}= |
if ( $internaltext =~ /^\s*$/ && $default !~ /^\s*$/) { |
$metacache{$uri.':'.$unikey.'.default'}; |
# only ws inside the tag, and not in default, so use default |
} |
# as value |
|
$metacache{$uri.':'.$unikey}=$default; |
|
} else { |
|
# either something interesting inside the tag or default |
|
# uninteresting |
|
$metacache{$uri.':'.$unikey}=$internaltext; |
|
} |
# end of not-a-package not-a-library import |
# end of not-a-package not-a-library import |
} |
} |
# end of not-a-package start tag |
# end of not-a-package start tag |