version 1.567, 2004/11/10 19:03:04
|
version 1.573, 2004/12/04 18:35:27
|
Line 38 use vars
|
Line 38 use vars
|
qw(%perlvar %hostname %homecache %badServerCache %hostip %iphost %spareid %hostdom |
qw(%perlvar %hostname %homecache %badServerCache %hostip %iphost %spareid %hostdom |
%libserv %pr %prp %metacache %packagetab %titlecache %courseresversioncache %resversioncache |
%libserv %pr %prp %metacache %packagetab %titlecache %courseresversioncache %resversioncache |
%courselogs %accesshash %userrolehash $processmarker $dumpcount |
%courselogs %accesshash %userrolehash $processmarker $dumpcount |
%coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseresdatacache |
%coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseownerbuf %courseresdatacache |
%userresdatacache %getsectioncache %domaindescription %domain_auth_def %domain_auth_arg_def |
%userresdatacache %getsectioncache %domaindescription %domain_auth_def %domain_auth_arg_def |
%domain_lang_def %domain_city %domain_longi %domain_lati $tmpdir $_64bit); |
%domain_lang_def %domain_city %domain_longi %domain_lati $tmpdir $_64bit); |
|
|
Line 1407 sub finishuserfileupload {
|
Line 1407 sub finishuserfileupload {
|
# Save the file |
# Save the file |
{ |
{ |
#&Apache::lonnet::logthis("Saving to $filepath $file"); |
#&Apache::lonnet::logthis("Saving to $filepath $file"); |
open(my $fh,'>'.$filepath.'/'.$file); |
open(FH,'>'.$filepath.'/'.$file); |
print $fh $ENV{'form.'.$formname}; |
print FH $ENV{'form.'.$formname}; |
close($fh); |
close(FH); |
} |
} |
# Notify homeserver to grep it |
# Notify homeserver to grep it |
# |
# |
Line 1490 sub flushcourselogs {
|
Line 1490 sub flushcourselogs {
|
if ($courseidbuffer{$coursehombuf{$crsid}}) { |
if ($courseidbuffer{$coursehombuf{$crsid}}) { |
$courseidbuffer{$coursehombuf{$crsid}}.='&'. |
$courseidbuffer{$coursehombuf{$crsid}}.='&'. |
&escape($crsid).'='.&escape($coursedescrbuf{$crsid}). |
&escape($crsid).'='.&escape($coursedescrbuf{$crsid}). |
'='.&escape($courseinstcodebuf{$crsid}); |
':'.&escape($courseinstcodebuf{$crsid}).':'.&escape($courseownerbuf{$crsid}); |
} else { |
} else { |
$courseidbuffer{$coursehombuf{$crsid}}= |
$courseidbuffer{$coursehombuf{$crsid}}= |
&escape($crsid).'='.&escape($coursedescrbuf{$crsid}). |
&escape($crsid).'='.&escape($coursedescrbuf{$crsid}). |
'='.&escape($courseinstcodebuf{$crsid}); |
':'.&escape($courseinstcodebuf{$crsid}).':'.&escape($courseownerbuf{$crsid}); |
} |
} |
} |
} |
# |
# |
# Write course id database (reverse lookup) to homeserver of courses |
# Write course id database (reverse lookup) to homeserver of courses |
Line 1570 sub courselog {
|
Line 1570 sub courselog {
|
$ENV{'course.'.$ENV{'request.course.id'}.'.description'}; |
$ENV{'course.'.$ENV{'request.course.id'}.'.description'}; |
$courseinstcodebuf{$ENV{'request.course.id'}}= |
$courseinstcodebuf{$ENV{'request.course.id'}}= |
$ENV{'course.'.$ENV{'request.course.id'}.'.internal.coursecode'}; |
$ENV{'course.'.$ENV{'request.course.id'}.'.internal.coursecode'}; |
|
$courseownerbuf{$ENV{'request.course.id'}}= |
|
$ENV{'course.'.$ENV{'request.course.id'}.'.internal.courseowner'}; |
if (defined $courselogs{$ENV{'request.course.id'}}) { |
if (defined $courselogs{$ENV{'request.course.id'}}) { |
$courselogs{$ENV{'request.course.id'}}.='&'.$what; |
$courselogs{$ENV{'request.course.id'}}.='&'.$what; |
} else { |
} else { |
Line 1713 sub courseidput {
|
Line 1715 sub courseidput {
|
} |
} |
|
|
sub courseiddump { |
sub courseiddump { |
my ($domfilter,$descfilter,$sincefilter,$hostidflag,$hostidref)=@_; |
my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter,$hostidflag,$hostidref)=@_; |
my %returnhash=(); |
my %returnhash=(); |
unless ($domfilter) { $domfilter=''; } |
unless ($domfilter) { $domfilter=''; } |
foreach my $tryserver (keys %libserv) { |
foreach my $tryserver (keys %libserv) { |
Line 1721 sub courseiddump {
|
Line 1723 sub courseiddump {
|
if ((!$domfilter) || ($hostdom{$tryserver} eq $domfilter)) { |
if ((!$domfilter) || ($hostdom{$tryserver} eq $domfilter)) { |
foreach ( |
foreach ( |
split(/\&/,&reply('courseiddump:'.$hostdom{$tryserver}.':'. |
split(/\&/,&reply('courseiddump:'.$hostdom{$tryserver}.':'. |
$sincefilter.':'.&escape($descfilter), |
$sincefilter.':'.&escape($descfilter).':'. |
|
&escape($instcodefilter).':'.&escape($ownerfilter), |
$tryserver))) { |
$tryserver))) { |
my ($key,$value)=split(/\=/,$_); |
my ($key,$value)=split(/\=/,$_); |
if (($key) && ($value)) { |
if (($key) && ($value)) { |
Line 3687 sub writecoursepref {
|
Line 3690 sub writecoursepref {
|
# ---------------------------------------------------------- Make/modify course |
# ---------------------------------------------------------- Make/modify course |
|
|
sub createcourse { |
sub createcourse { |
my ($udom,$description,$url,$course_server,$nonstandard,$inst_code)=@_; |
my ($udom,$description,$url,$course_server,$nonstandard,$inst_code,$course_owner)=@_; |
$url=&declutter($url); |
$url=&declutter($url); |
my $cid=''; |
my $cid=''; |
unless (&allowed('ccc',$udom)) { |
unless (&allowed('ccc',$udom)) { |
Line 3722 sub createcourse {
|
Line 3725 sub createcourse {
|
# ----------------------------------------------------------------- Course made |
# ----------------------------------------------------------------- Course made |
# log existence |
# log existence |
&courseidput($udom,&escape($udom.'_'.$uname).'='.&escape($description). |
&courseidput($udom,&escape($udom.'_'.$uname).'='.&escape($description). |
'='.&escape($inst_code),$uhome); |
':'.&escape($inst_code).':'.&escape($course_owner),$uhome); |
&flushcourselogs(); |
&flushcourselogs(); |
# set toplevel url |
# set toplevel url |
my $topurl=$url; |
my $topurl=$url; |
Line 3809 sub mark_as_readonly {
|
Line 3812 sub mark_as_readonly {
|
return; |
return; |
} |
} |
|
|
|
# ------------------------------------------------------------Save Selected Files |
|
|
|
sub save_selected_files { |
|
my ($user, $path, @files) = @_; |
|
my $filename = $user."savedfiles"; |
|
my @other_files = &files_not_in_path($user, $path); |
|
foreach (@other_files) { |
|
&logthis("other dir file $_"); |
|
} |
|
foreach (@files) { |
|
&logthis("current dir file $_"); |
|
} |
|
open OUT, '>'.$Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/'.$filename; |
|
foreach my $file (@files) { |
|
print OUT $ENV{'form.currentpath'}.$file."\n"; |
|
} |
|
foreach my $file (@other_files) { |
|
print OUT $file."\n"; |
|
} |
|
close OUT; |
|
return 'ok'; |
|
} |
|
|
|
sub files_in_path { |
|
my ($user, $path) = @_; |
|
my $filename = $user."savedfiles"; |
|
my %return_files; |
|
open IN, '<'.$Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/'.$filename; |
|
while (my $line_in = <IN>) { |
|
chomp $line_in; |
|
my @paths_and_file = split m!/!, $line_in; |
|
my $file_part = pop @paths_and_file; |
|
my $path_part = join '/', @paths_and_file; |
|
$path_part.='/'; |
|
my $path_and_file = $path_part.$file_part; |
|
if ($path_part eq $path) { |
|
$return_files{$file_part}= 'selected'; |
|
} |
|
} |
|
close IN; |
|
return \%return_files; |
|
} |
|
|
|
# called in portfolio select mode, to show files selected NOT in current directory |
|
sub files_not_in_path { |
|
my ($user, $path) = @_; |
|
my $filename = $user."savedfiles"; |
|
my @return_files; |
|
my $path_part; |
|
open IN, '<'.$Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/'.$filename; |
|
while (<IN>) { |
|
#ok, I know it's clunky, but I want it to work |
|
my @paths_and_file = split m!/!, $_; |
|
my $file_part = pop @paths_and_file; |
|
chomp $file_part; |
|
my $path_part = join '/', @paths_and_file; |
|
$path_part .= '/'; |
|
my $path_and_file = $path_part.$file_part; |
|
if ($path_part ne $path) { |
|
push @return_files, ($path_and_file); |
|
} |
|
} |
|
close OUT; |
|
return @return_files; |
|
} |
|
|
#--------------------------------------------------------------Get Marked as Read Only |
#--------------------------------------------------------------Get Marked as Read Only |
|
|
sub get_marked_as_readonly { |
sub get_marked_as_readonly { |
Line 4710 sub symbverify {
|
Line 4779 sub symbverify {
|
|
|
sub symbclean { |
sub symbclean { |
my $symb=shift; |
my $symb=shift; |
|
if ($symb=~m|^/enc/|) { $symb=&Apache::lonenc::unencrypted($symb); } |
# remove version from map |
# remove version from map |
$symb=~s/\.(\d+)\.(\w+)\_\_\_/\.$2\_\_\_/; |
$symb=~s/\.(\d+)\.(\w+)\_\_\_/\.$2\_\_\_/; |
|
|
Line 4731 sub encode_symb {
|
Line 4800 sub encode_symb {
|
} |
} |
|
|
sub decode_symb { |
sub decode_symb { |
my ($map,$resid,$url)=split(/\_\_\_/,shift); |
my $symb=shift; |
|
if ($symb=~m|^/enc/|) { $symb=&Apache::lonenc::unencrypted($symb); } |
|
my ($map,$resid,$url)=split(/___/,$symb); |
return (&fixversion($map),$resid,&fixversion($url)); |
return (&fixversion($map),$resid,&fixversion($url)); |
} |
} |
|
|
Line 4780 sub symbread {
|
Line 4851 sub symbread {
|
} |
} |
$thisfn=$ENV{'request.filename'}; |
$thisfn=$ENV{'request.filename'}; |
} |
} |
|
if ($thisfn=~m|^/enc/|) { $thisfn=&Apache::lonenc::unencrypted($thisfn); } |
# is that filename actually a symb? Verify, clean, and return |
# is that filename actually a symb? Verify, clean, and return |
if ($thisfn=~/\_\_\_\d+\_\_\_(.*)$/) { |
if ($thisfn=~/\_\_\_\d+\_\_\_(.*)$/) { |
if (&symbverify($thisfn,$1)) { |
if (&symbverify($thisfn,$1)) { |
Line 5330 sub current_machine_ids {
|
Line 5402 sub current_machine_ids {
|
|
|
sub declutter { |
sub declutter { |
my $thisfn=shift; |
my $thisfn=shift; |
|
if ($thisfn=~m|^/enc/|) { $thisfn=&Apache::lonenc::unencrypted($thisfn); } |
$thisfn=~s/^\Q$perlvar{'lonDocRoot'}\E//; |
$thisfn=~s/^\Q$perlvar{'lonDocRoot'}\E//; |
$thisfn=~s/^\///; |
$thisfn=~s/^\///; |
$thisfn=~s/^res\///; |
$thisfn=~s/^res\///; |
Line 5565 $readit=1;
|
Line 5638 $readit=1;
|
{ |
{ |
use integer; |
use integer; |
my $test=(2**32)+1; |
my $test=(2**32)+1; |
if ($test != 0) { $_64bit=1; } |
if ($test != 0) { $_64bit=1; } else { $_64bit=0; } |
&logthis(" Detected 64bit platform ($_64bit)"); |
&logthis(" Detected 64bit platform ($_64bit)"); |
} |
} |
} |
} |