--- loncom/lonnet/perl/lonnet.pm 2002/08/02 21:11:55 1.260 +++ loncom/lonnet/perl/lonnet.pm 2002/08/08 13:42:01 1.263 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.260 2002/08/02 21:11:55 ng Exp $ +# $Id: lonnet.pm,v 1.263 2002/08/08 13:42:01 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -608,6 +608,18 @@ sub userenvironment { 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 sub subscribe { @@ -766,10 +778,15 @@ sub userfileupload { } # 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 '/uploaded/'.$path.$fname; + return '/uploaded/'.$path.$fname; + } else { + return '/adm/notfound.html'; + } } # ------------------------------------------------------------------------- Log @@ -1580,6 +1597,10 @@ sub allowed { return ''; } } + if ($ENV{'request.role'}=~ /li\.\//) { + # Library role, so allow browsing of resources in this domain. + return 'F'; + } } my $thisallowed=''; @@ -2703,6 +2724,7 @@ sub metadata { # the next is the end of "start tag" } } + &metadata_generate_part0(\%metathesekeys,\%metacache,$uri); $metacache{$uri.':keys'}=join(',',keys %metathesekeys); $metacache{$uri.':cachedtimestamp'}=time; # this is the end of "was not already recently cached @@ -2710,6 +2732,34 @@ sub metadata { 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 sub symblist {