version 1.267.4.7, 2002/09/17 20:01:30
|
version 1.279, 2002/09/07 17:53:05
|
Line 351 sub delenv {
|
Line 351 sub delenv {
|
# ------------------------------ Find server with least workload from spare.tab |
# ------------------------------ Find server with least workload from spare.tab |
|
|
sub spareserver { |
sub spareserver { |
my $loadpercent = shift; |
|
my $tryserver; |
my $tryserver; |
my $spareserver=''; |
my $spareserver=''; |
my $lowestserver=$loadpercent; |
my $lowestserver=100; |
foreach $tryserver (keys %spareid) { |
foreach $tryserver (keys %spareid) { |
my $answer=reply('load',$tryserver); |
my $answer=reply('load',$tryserver); |
if (($answer =~ /\d/) && ($answer<$lowestserver)) { |
if (($answer =~ /\d/) && ($answer<$lowestserver)) { |
Line 762 sub userfileupload {
|
Line 761 sub userfileupload {
|
$docudom=$ENV{'user.domain'}; |
$docudom=$ENV{'user.domain'}; |
$docuhome=$ENV{'user.home'}; |
$docuhome=$ENV{'user.home'}; |
} |
} |
|
return |
|
&finishuserfileupload($docuname,$docudom,$docuhome,$formname,$fname); |
|
} |
|
|
|
sub finishuserfileupload { |
|
my ($docuname,$docudom,$docuhome,$formname,$fname)=@_; |
my $path=$docudom.'/'.$docuname.'/'; |
my $path=$docudom.'/'.$docuname.'/'; |
my $filepath=$perlvar{'lonDocRoot'}; |
my $filepath=$perlvar{'lonDocRoot'}; |
my @parts=split(/\//,$filepath.'/userfiles/'.$path); |
my @parts=split(/\//,$filepath.'/userfiles/'.$path); |
Line 1436 sub coursedescription {
|
Line 1441 sub coursedescription {
|
while (my ($name,$value) = each %returnhash) { |
while (my ($name,$value) = each %returnhash) { |
$envhash{'course.'.$normalid.'.'.$name}=$value; |
$envhash{'course.'.$normalid.'.'.$name}=$value; |
} |
} |
$returnhash{'url'}='/res/'.declutter($returnhash{'url'}); |
$returnhash{'url'}=&clutter($returnhash{'url'}); |
$returnhash{'fn'}=$perlvar{'lonDaemons'}.'/tmp/'. |
$returnhash{'fn'}=$perlvar{'lonDaemons'}.'/tmp/'. |
$ENV{'user.name'}.'_'.$cdomain.'_'.$cnum; |
$ENV{'user.name'}.'_'.$cdomain.'_'.$cnum; |
$envhash{'course.'.$normalid.'.last_cache'}=time; |
$envhash{'course.'.$normalid.'.last_cache'}=time; |
Line 1564 sub get {
|
Line 1569 sub get {
|
|
|
my $rep=&reply("get:$udomain:$uname:$namespace:$items",$uhome); |
my $rep=&reply("get:$udomain:$uname:$namespace:$items",$uhome); |
my @pairs=split(/\&/,$rep); |
my @pairs=split(/\&/,$rep); |
|
if ( $#pairs==0 && $pairs[0] =~ /^(con_lost|error|no_such_host)/i) { |
|
return @pairs; |
|
} |
my %returnhash=(); |
my %returnhash=(); |
my $i=0; |
my $i=0; |
foreach (@$storearr) { |
foreach (@$storearr) { |
Line 2296 sub writecoursepref {
|
Line 2304 sub writecoursepref {
|
# ---------------------------------------------------------- Make/modify course |
# ---------------------------------------------------------- Make/modify course |
|
|
sub createcourse { |
sub createcourse { |
my ($udom,$description,$url,$course_server)=@_; |
my ($udom,$description,$url,$course_server,$nonstandard)=@_; |
$url=&declutter($url); |
$url=&declutter($url); |
my $cid=''; |
my $cid=''; |
unless (&allowed('ccc',$udom)) { |
unless (&allowed('ccc',$udom)) { |
Line 2328 sub createcourse {
|
Line 2336 sub createcourse {
|
if (($uhome eq '') || ($uhome eq 'no_host')) { |
if (($uhome eq '') || ($uhome eq 'no_host')) { |
return 'error: no such course'; |
return 'error: no such course'; |
} |
} |
|
# ----------------------------------------------------------------- Course made |
|
my $topurl=$url; |
|
unless ($nonstandard) { |
|
# ------------------------------------------ For standard courses, make top url |
|
my $mapurl=&clutter($url); |
|
if ($mapurl eq '/res/') { $mapurl=''; } |
|
$ENV{'form.initmap'}=(<<ENDINITMAP); |
|
<map> |
|
<resource id="1" type="start"></resource> |
|
<resource id="2" src="$mapurl"></resource> |
|
<resource id="3" type="finish"></resource> |
|
<link index="1" from="1" to="2"></link> |
|
<link index="2" from="2" to="3"></link> |
|
</map> |
|
ENDINITMAP |
|
$topurl=&declutter( |
|
&finishuserfileupload($uname,$udom,$uhome,'initmap','default.sequence') |
|
); |
|
} |
|
# ----------------------------------------------------------- Write preferences |
&writecoursepref($udom.'_'.$uname, |
&writecoursepref($udom.'_'.$uname, |
('description' => $description, |
('description' => $description, |
'url' => $url)); |
'url' => $topurl)); |
return '/'.$udom.'/'.$uname; |
return '/'.$udom.'/'.$uname; |
} |
} |
|
|
Line 2507 sub condval {
|
Line 2535 sub condval {
|
return $result; |
return $result; |
} |
} |
|
|
|
# ---------------------------------------------------- Devalidate courseresdata |
|
|
|
sub devalidatecourseresdata { |
|
my ($coursenum,$coursedomain)=@_; |
|
my $hashid=$coursenum.':'.$coursedomain; |
|
delete $courseresdatacache{$hashid.'.time'}; |
|
} |
|
|
# --------------------------------------------------- Course Resourcedata Query |
# --------------------------------------------------- Course Resourcedata Query |
|
|
sub courseresdata { |
sub courseresdata { |
Line 2538 sub courseresdata {
|
Line 2574 sub courseresdata {
|
# --------------------------------------------------------- Value of a Variable |
# --------------------------------------------------------- Value of a Variable |
|
|
sub EXT { |
sub EXT { |
my ($varname,$symbparm,$udom,$uname,)=@_; |
my ($varname,$symbparm,$udom,$uname)=@_; |
|
|
unless ($varname) { return ''; } |
unless ($varname) { return ''; } |
|
|
Line 2695 sub EXT {
|
Line 2731 sub EXT {
|
# --------------------------------------------- last, look in resource metadata |
# --------------------------------------------- last, look in resource metadata |
|
|
$spacequalifierrest=~s/\./\_/; |
$spacequalifierrest=~s/\./\_/; |
my $filename; |
my $metadata=&metadata($ENV{'request.filename'},$spacequalifierrest); |
if (!$symbparm) { $symbparm=&symbread(); } |
|
if ($symbparm) { |
|
$filename=(split(/\_\_\_/,$symbparm))[2]; |
|
} else { |
|
$filename=$ENV{'request.filename'}; |
|
} |
|
my $metadata=&metadata($filename,$spacequalifierrest); |
|
if ($metadata) { return $metadata; } |
if ($metadata) { return $metadata; } |
$metadata=&metadata($filename,'parameter_'.$spacequalifierrest); |
$metadata=&metadata($ENV{'request.filename'}, |
|
'parameter_'.$spacequalifierrest); |
if ($metadata) { return $metadata; } |
if ($metadata) { return $metadata; } |
|
|
# ------------------------------------------------------------------ Cascade up |
# ------------------------------------------------------------------ Cascade up |
Line 3118 sub receipt {
|
Line 3148 sub receipt {
|
# ------------------------------------------------------------ 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 { |
my $file=shift; |
my $file=shift; |
|
if ($file=~/^\/*uploaded\//) { # user file |
|
my $ua=new LWP::UserAgent; |
|
my $request=new HTTP::Request('GET',&tokenwrapper($file)); |
|
my $response=$ua->request($request); |
|
if ($response->is_success()) { |
|
return $response->content; |
|
} else { |
|
return -1; |
|
} |
|
} else { # normal file from res space |
&repcopy($file); |
&repcopy($file); |
if (! -e $file ) { return -1; }; |
if (! -e $file ) { return -1; }; |
my $fh=Apache::File->new($file); |
my $fh=Apache::File->new($file); |
my $a=''; |
my $a=''; |
while (<$fh>) { $a .=$_; } |
while (<$fh>) { $a .=$_; } |
return $a |
return $a; |
|
} |
} |
} |
|
|
sub filelocation { |
sub filelocation { |
Line 3134 sub filelocation {
|
Line 3175 sub filelocation {
|
if ($file=~m:^/~:) { # is a contruction space reference |
if ($file=~m:^/~:) { # is a contruction space reference |
$location = $file; |
$location = $file; |
$location =~ s:/~(.*?)/(.*):/home/$1/public_html/$2:; |
$location =~ s:/~(.*?)/(.*):/home/$1/public_html/$2:; |
|
} elsif ($file=~/^\/*uploaded/) { # is an uploaded file |
|
$location=$file; |
} else { |
} else { |
$file=~s/^$perlvar{'lonDocRoot'}//; |
$file=~s/^$perlvar{'lonDocRoot'}//; |
$file=~s:^/*res::; |
$file=~s:^/*res::; |
Line 3171 sub declutter {
|
Line 3214 sub declutter {
|
return $thisfn; |
return $thisfn; |
} |
} |
|
|
|
# ------------------------------------------------------------- Clutter up URLs |
|
|
|
sub clutter { |
|
my $thisfn='/'.&declutter(shift); |
|
unless ($thisfn=~/^\/(uploaded|adm|userfiles|ext|raw|priv)\//) { |
|
$thisfn='/res'.$thisfn; |
|
} |
|
return $thisfn; |
|
} |
|
|
# -------------------------------------------------------- Escape Special Chars |
# -------------------------------------------------------- Escape Special Chars |
|
|
sub escape { |
sub escape { |
Line 3248 BEGIN {
|
Line 3301 BEGIN {
|
|
|
while (my $configline=<$config>) { |
while (my $configline=<$config>) { |
chomp($configline); |
chomp($configline); |
if ($configline) { |
if (($configline) && ($configline ne $perlvar{'lonHostID'})) { |
$spareid{$configline}=1; |
$spareid{$configline}=1; |
} |
} |
} |
} |