--- loncom/lonnet/perl/lonnet.pm 2002/10/01 19:09:27 1.289 +++ loncom/lonnet/perl/lonnet.pm 2002/10/10 13:06:08 1.295 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.289 2002/10/01 19:09:27 bowersj2 Exp $ +# $Id: lonnet.pm,v 1.295 2002/10/10 13:06:08 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -86,6 +86,8 @@ use GDBM_File; use Apache::Constants qw(:common :http); use HTML::LCParser; use Fcntl qw(:flock); +use Apache::loncoursedata; + my $readit; # --------------------------------------------------------------------- Logging @@ -644,6 +646,30 @@ sub chatsend { &escape($newentry)),$chome); } +# ------------------------------------------ Find current version of a resource + +sub getversion { + my $fname=&clutter(shift); + unless ($fname=~/^\/res\//) { return -1; } + return ¤tversion(&filelocation('',$fname)); +} + +sub currentversion { + my $fname=shift; + my $author=$fname; + $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/; + my ($udom,$uname)=split(/\//,$author); + my $home=homeserver($uname,$udom); + if ($home eq 'no_host') { + return -1; + } + my $answer=reply("currentversion:$fname",$home); + if (($answer eq 'con_lost') || ($answer eq 'rejected')) { + return -1; + } + return $answer; +} + # ----------------------------- Subscribe to a resource, return URL if possible sub subscribe { @@ -652,7 +678,7 @@ sub subscribe { $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/; my ($udom,$uname)=split(/\//,$author); my $home=homeserver($uname,$udom); - if (($home eq 'no_host') || ($home eq $perlvar{'lonHostID'})) { + if ($home eq 'no_host') { return 'not_found'; } my $answer=reply("sub:$fname",$home); @@ -683,6 +709,11 @@ sub repcopy { } elsif ($remoteurl eq 'directory') { return OK; } else { + my $author=$filename; + $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/; + my ($udom,$uname)=split(/\//,$author); + my $home=homeserver($uname,$udom); + unless ($home eq $perlvar{'lonHostID'}) { my @parts=split(/\//,$filename); my $path="/$parts[1]/$parts[2]/$parts[3]/$parts[4]"; if ($path ne "$perlvar{'lonDocRoot'}/res") { @@ -718,6 +749,7 @@ sub repcopy { rename($transname,$filename); return OK; } + } } } @@ -808,13 +840,16 @@ sub finishuserfileupload { } # Notify homeserver to grep it # - if -(&reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$fname,$docuhome) eq 'ok') - { + + my $fetchresult= + &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$fname,$docuhome); + if ($fetchresult eq 'ok') { # # Return the URL to it return '/uploaded/'.$path.$fname; } else { + &logthis('Failed to transfer '.$docudom.'/'.$docuname.'/'.$fname. + ' to host '.$docuhome.': '.$fetchresult); return '/adm/notfound.html'; } } @@ -2290,10 +2325,24 @@ sub modifystudent { return 'error: no such user'; } # -------------------------------------------------- Add student to course list + if ($first eq '' || $last eq '' || $uid eq '') { + # They did not supply us with enough data to enroll the student, so + # we need to pick up more information. + my %tmp = dump('environment',$udom,$uname, + ['firstname','middlename','lastname', 'generation','id'] + ); + $first = $tmp{'firstname'} if (!defined($first) || $first eq ''); + $middle = $tmp{'middlename'} if (!defined($middle) || $middle eq ''); + $last = $tmp{'lastname'} if (!defined($last) || $last eq ''); + $gene = $tmp{'genename'} if (!defined($gene) || $gene eq ''); + $uid = $tmp{'id'} if (!defined($uid) || $uid eq ''); + } + my $fullname = &Apache::loncoursedata::ProcessFullName($last,$gene, + $first,$middle); $reply=critical('put:'.$ENV{'course.'.$cid.'.domain'}.':'. $ENV{'course.'.$cid.'.num'}.':classlist:'. &escape($uname.':'.$udom).'='. - &escape($end.':'.$start), + &escape(join(':',$end,$start,$uid,$usec,$fullname)), $ENV{'course.'.$cid.'.home'}); unless (($reply eq 'ok') || ($reply eq 'delayed')) { return 'error: '.$reply; @@ -2593,7 +2642,7 @@ sub courseresdata { return $courseresdatacache{$hashid}->{$item}; } } - return ''; + return undef; } # --------------------------------------------------------- Value of a Variable @@ -2808,8 +2857,8 @@ sub metadata { $uri=&declutter($uri); # if it is a non metadata possible uri return quickly - if (($uri eq '') || ($uri =~ m|^/*adm/|) || ($uri =~ m|/$|) || - ($uri =~ m|/.meta$|)) { + if (($uri eq '') || (($uri =~ m|^/*adm/|) && ($uri !~ m|^adm/includes|)) || + ($uri =~ m|/$|) || ($uri =~ m|/.meta$|)) { return ''; } my $filename=$uri;