version 1.572, 2004/12/04 02:14:19
|
version 1.575, 2004/12/07 16:19:37
|
Line 3817 sub mark_as_readonly {
|
Line 3817 sub mark_as_readonly {
|
sub save_selected_files { |
sub save_selected_files { |
my ($user, $path, @files) = @_; |
my ($user, $path, @files) = @_; |
my $filename = $user."savedfiles"; |
my $filename = $user."savedfiles"; |
open OUT, '>'.$Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/'.$filename; |
my @other_files = &files_not_in_path($user, $path); |
|
foreach (@other_files) { |
|
&logthis("other dir file $_"); |
|
} |
foreach (@files) { |
foreach (@files) { |
print OUT $ENV{'form.currentpath'}.$_."\n"; |
&logthis("current dir file $_"); |
|
} |
|
open (OUT, '>'.$Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/'.$filename); |
|
foreach my $file (@files) { |
|
print (OUT $ENV{'form.currentpath'}.$file."\n"); |
} |
} |
close OUT; |
foreach my $file (@other_files) { |
|
print (OUT $file."\n"); |
|
} |
|
close (OUT); |
return 'ok'; |
return 'ok'; |
} |
} |
|
|
|
sub clear_selected_files { |
|
my ($user) = @_; |
|
my $filename = $user."savedfiles"; |
|
open (OUT, '>'.$Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/'.$filename); |
|
print (OUT undef); |
|
close (OUT); |
|
return ("ok"); |
|
} |
|
|
sub files_in_path { |
sub files_in_path { |
my ($user, $path) = @_; |
my ($user, $path) = @_; |
my $filename = $user."savedfiles"; |
my $filename = $user."savedfiles"; |
my %return_files; |
my %return_files; |
open IN, '<'.$Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/'.$filename; |
open (IN, '<'.$Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/'.$filename); |
return \%return_files; |
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 |
# called in portfolio select mode, to show files selected NOT in current directory |
Line 3839 sub files_not_in_path {
|
Line 3870 sub files_not_in_path {
|
my $filename = $user."savedfiles"; |
my $filename = $user."savedfiles"; |
my @return_files; |
my @return_files; |
my $path_part; |
my $path_part; |
open IN, '<'.$Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/'.$filename; |
open (IN, '<'.$Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/'.$filename); |
while (<IN>) { |
while (<IN>) { |
#ok, I know it's clunky, but I want it to work |
#ok, I know it's clunky, but I want it to work |
my @paths_and_file = split m!/!, $_; |
my @paths_and_file = split m!/!, $_; |
my $file_part = pop @paths_and_file; |
my $file_part = pop (@paths_and_file); |
my $path_part = join '/', @paths_and_file; |
chomp ($file_part); |
|
my $path_part = join ('/', @paths_and_file); |
$path_part .= '/'; |
$path_part .= '/'; |
my $path_and_file = $path_part.$file_part; |
my $path_and_file = $path_part.$file_part; |
if ($path_part ne $path) { |
if ($path_part ne $path) { |
push @return_files, ($path_and_file); |
push (@return_files, ($path_and_file)); |
&logthis("path part is $path_part file is $file_part"); |
|
} else { |
|
&logthis("path part is $path_part file is $file_part"); |
|
} |
} |
} |
} |
close OUT; |
close (OUT); |
return @return_files; |
return (@return_files); |
} |
} |
|
|
#--------------------------------------------------------------Get Marked as Read Only |
#--------------------------------------------------------------Get Marked as Read Only |
Line 4670 sub gettitle {
|
Line 4699 sub gettitle {
|
my $symb=&symbread($urlsymb); |
my $symb=&symbread($urlsymb); |
if ($symb) { |
if ($symb) { |
my ($result,$cached)=&is_cached(\%titlecache,$symb,'title',600); |
my ($result,$cached)=&is_cached(\%titlecache,$symb,'title',600); |
if (defined($cached)) { return $result; } |
if (defined($cached)) { |
|
return $result; |
|
} |
my ($map,$resid,$url)=&decode_symb($symb); |
my ($map,$resid,$url)=&decode_symb($symb); |
my $title=''; |
my $title=''; |
my %bighash; |
my %bighash; |
Line 4942 sub numval2 {
|
Line 4973 sub numval2 {
|
return int($total); |
return int($total); |
} |
} |
|
|
|
sub numval3 { |
|
use integer; |
|
my $txt=shift; |
|
$txt=~tr/A-J/0-9/; |
|
$txt=~tr/a-j/0-9/; |
|
$txt=~tr/K-T/0-9/; |
|
$txt=~tr/k-t/0-9/; |
|
$txt=~tr/U-Z/0-5/; |
|
$txt=~tr/u-z/0-5/; |
|
$txt=~s/\D//g; |
|
my @txts=split(/(\d\d\d\d\d\d\d\d\d)/,$txt); |
|
my $total; |
|
foreach my $val (@txts) { $total+=$val; } |
|
if ($_64bit) { $total=(($total<<32)>>32); } |
|
return $total; |
|
} |
|
|
sub latest_rnd_algorithm_id { |
sub latest_rnd_algorithm_id { |
return '64bit3'; |
return '64bit4'; |
} |
} |
|
|
sub get_rand_alg { |
sub get_rand_alg { |
Line 4982 sub rndseed {
|
Line 5030 sub rndseed {
|
if (!$username) { $username=$wusername } |
if (!$username) { $username=$wusername } |
my $which=&get_rand_alg(); |
my $which=&get_rand_alg(); |
if (defined(&getCODE())) { |
if (defined(&getCODE())) { |
return &rndseed_CODE_64bit($symb,$courseid,$domain,$username); |
if ($which eq '64bit4') { |
|
return &rndseed_CODE_64bit4($symb,$courseid,$domain,$username); |
|
} else { |
|
return &rndseed_CODE_64bit($symb,$courseid,$domain,$username); |
|
} |
|
} elsif ($which eq '64bit4') { |
|
return &rndseed_64bit4($symb,$courseid,$domain,$username); |
} elsif ($which eq '64bit3') { |
} elsif ($which eq '64bit3') { |
return &rndseed_64bit3($symb,$courseid,$domain,$username); |
return &rndseed_64bit3($symb,$courseid,$domain,$username); |
} elsif ($which eq '64bit2') { |
} elsif ($which eq '64bit2') { |
Line 5079 sub rndseed_64bit3 {
|
Line 5133 sub rndseed_64bit3 {
|
} |
} |
} |
} |
|
|
|
sub rndseed_64bit4 { |
|
my ($symb,$courseid,$domain,$username)=@_; |
|
{ |
|
use integer; |
|
# strings need to be an even # of cahracters long, it it is odd the |
|
# last characters gets thrown away |
|
my $symbchck=unpack("%32S*",$symb.' ') << 21; |
|
my $symbseed=numval3($symb) << 10; |
|
my $namechck=unpack("%32S*",$username.' '); |
|
|
|
my $nameseed=numval3($username) << 21; |
|
my $domainseed=unpack("%32S*",$domain.' ') << 10; |
|
my $courseseed=unpack("%32S*",$courseid.' '); |
|
|
|
my $num1=$symbchck+$symbseed+$namechck; |
|
my $num2=$nameseed+$domainseed+$courseseed; |
|
#&Apache::lonxml::debug("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck"); |
|
#&Apache::lonxml::debug("rndseed :$num1:$num2:$_64bit"); |
|
if ($_64bit) { $num1=(($num1<<32)>>32); $num2=(($num2<<32)>>32); } |
|
|
|
return "$num1:$num2"; |
|
} |
|
} |
|
|
sub rndseed_CODE_64bit { |
sub rndseed_CODE_64bit { |
my ($symb,$courseid,$domain,$username)=@_; |
my ($symb,$courseid,$domain,$username)=@_; |
{ |
{ |
Line 5090 sub rndseed_CODE_64bit {
|
Line 5168 sub rndseed_CODE_64bit {
|
my $courseseed=unpack("%32S*",$courseid.' '); |
my $courseseed=unpack("%32S*",$courseid.' '); |
my $num1=$symbseed+$CODEchck; |
my $num1=$symbseed+$CODEchck; |
my $num2=$CODEseed+$courseseed+$symbchck; |
my $num2=$CODEseed+$courseseed+$symbchck; |
|
#&Apache::lonxml::debug("$symbseed:$CODEchck|$CODEseed:$courseseed:$symbchck"); |
|
#&Apache::lonxml::debug("rndseed :$num1:$num2:$symb"); |
|
if ($_64bit) { $num1=(($num1<<32)>>32); } |
|
if ($_64bit) { $num2=(($num2<<32)>>32); } |
|
return "$num1:$num2"; |
|
} |
|
} |
|
|
|
sub rndseed_CODE_64bit4 { |
|
my ($symb,$courseid,$domain,$username)=@_; |
|
{ |
|
use integer; |
|
my $symbchck=unpack("%32S*",$symb.' ') << 16; |
|
my $symbseed=numval3($symb); |
|
my $CODEchck=unpack("%32S*",&getCODE().' ') << 16; |
|
my $CODEseed=numval3(&getCODE()); |
|
my $courseseed=unpack("%32S*",$courseid.' '); |
|
my $num1=$symbseed+$CODEchck; |
|
my $num2=$CODEseed+$courseseed+$symbchck; |
#&Apache::lonxml::debug("$symbseed:$CODEchck|$CODEseed:$courseseed:$symbchck"); |
#&Apache::lonxml::debug("$symbseed:$CODEchck|$CODEseed:$courseseed:$symbchck"); |
#&Apache::lonxml::debug("rndseed :$num1:$num2:$symb"); |
#&Apache::lonxml::debug("rndseed :$num1:$num2:$symb"); |
if ($_64bit) { $num1=(($num1<<32)>>32); } |
if ($_64bit) { $num1=(($num1<<32)>>32); } |