version 1.1075.2.127.2.5, 2018/05/02 19:12:31
|
version 1.1075.2.127.2.8, 2019/02/07 16:45:53
|
Line 82 use Crypt::DES;
|
Line 82 use Crypt::DES;
|
use DynaLoader; # for Crypt::DES version |
use DynaLoader; # for Crypt::DES version |
use File::Copy(); |
use File::Copy(); |
use File::Path(); |
use File::Path(); |
|
use String::CRC32(); |
|
use Short::URL(); |
|
|
# ---------------------------------------------- Designs |
# ---------------------------------------------- Designs |
use vars qw(%defaultdesign); |
use vars qw(%defaultdesign); |
Line 13232 sub load_tmp_file {
|
Line 13234 sub load_tmp_file {
|
|
|
sub valid_datatoken { |
sub valid_datatoken { |
my ($datatoken) = @_; |
my ($datatoken) = @_; |
if ($datatoken =~ /^$match_username\_$match_domain\_enroll_$match_domain\_$match_courseid\_\d+_\d+$/) { |
if ($datatoken =~ /^$match_username\_$match_domain\_enroll_(|$match_domain\_$match_courseid)\_\d+_\d+$/) { |
return $datatoken; |
return $datatoken; |
} |
} |
return; |
return; |
Line 17055 sub des_decrypt {
|
Line 17057 sub des_decrypt {
|
return $plaintext; |
return $plaintext; |
} |
} |
|
|
|
sub make_short_symbs { |
|
my ($cdom,$cnum,$navmap) = @_; |
|
return unless (ref($navmap)); |
|
my ($numnew,@errors); |
|
my @toshorten = &Apache::loncommon::get_env_multiple('form.addtiny'); |
|
if (@toshorten) { |
|
my (%maps,%resources,%titles); |
|
&Apache::loncourserespicker::enumerate_course_contents($navmap,\%maps,\%resources,\%titles, |
|
'shorturls',$cdom,$cnum); |
|
my %tocreate; |
|
if (keys(%resources)) { |
|
foreach my $item (sort {$a <=> $b} (@toshorten)) { |
|
my $symb = $resources{$item}; |
|
if ($symb) { |
|
$tocreate{$cnum.'&'.$symb} = 1; |
|
} |
|
} |
|
} |
|
if (keys(%tocreate)) { |
|
my %coursetiny = &Apache::lonnet::dump('tiny',$cdom,$cnum); |
|
my $su = Short::URL->new(no_vowels => 1); |
|
my $init = ''; |
|
my (%newunique,%addcourse,%courseonly,%failed); |
|
# get lock on tiny db |
|
my $now = time; |
|
my $lockhash = { |
|
"lock\0$now" => $env{'user.name'}. |
|
':'.$env{'user.domain'}, |
|
}; |
|
my $tries = 0; |
|
my $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom); |
|
my ($code,$error); |
|
while (($gotlock ne 'ok') && ($tries<3)) { |
|
$tries ++; |
|
sleep 1; |
|
$gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom); |
|
} |
|
if ($gotlock eq 'ok') { |
|
$init = &shorten_symbs($cdom,$init,$su,\%coursetiny,\%tocreate,\%newunique, |
|
\%addcourse,\%courseonly,\%failed); |
|
if (keys(%failed)) { |
|
my $numfailed = scalar(keys(%failed)); |
|
push(@errors,&mt('error: could not obtain unique six character URL for [quant,_1,resource]',$numfailed)); |
|
} |
|
if (keys(%newunique)) { |
|
my $putres = &Apache::lonnet::newput_dom('tiny',\%newunique,$cdom); |
|
if ($putres eq 'ok') { |
|
$numnew = scalar(keys(%newunique)); |
|
my $newputres = &Apache::lonnet::newput('tiny',\%addcourse,$cdom,$cnum); |
|
unless ($newputres eq 'ok') { |
|
push(@errors,&mt('error: could not store course look-up of short URLs')); |
|
} |
|
} else { |
|
push(@errors,&mt('error: could not store unique six character URLs')); |
|
} |
|
} |
|
} |
|
} |
|
} |
|
return ($numnew,\@errors); |
|
} |
|
|
|
sub shorten_symbs { |
|
my ($cdom,$init,$su,$coursetiny,$tocreate,$newunique,$addcourse,$courseonly,$failed) = @_; |
|
return unless ((ref($su)) && (ref($coursetiny) eq 'HASH') && (ref($tocreate) eq 'HASH') && |
|
(ref($newunique) eq 'HASH') && (ref($addcourse) eq 'HASH') && |
|
(ref($courseonly) eq 'HASH') && (ref($failed) eq 'HASH')); |
|
my (%possibles,%collisions); |
|
foreach my $key (keys(%{$tocreate})) { |
|
my $num = String::CRC32::crc32($key); |
|
my $tiny = $su->encode($num,$init); |
|
if ($tiny) { |
|
$possibles{$tiny} = $key; |
|
} |
|
} |
|
if (!$init) { |
|
$init = 1; |
|
} else { |
|
$init ++; |
|
} |
|
if (keys(%possibles)) { |
|
my @posstiny = keys(%possibles); |
|
my $configuname = &Apache::lonnet::get_domainconfiguser($cdom); |
|
my %currtiny = &Apache::lonnet::get('tiny',\@posstiny,$cdom,$configuname); |
|
if (keys(%currtiny)) { |
|
foreach my $key (keys(%currtiny)) { |
|
next if ($currtiny{$key} eq ''); |
|
if ($currtiny{$key} eq $possibles{$key}) { |
|
my ($tcnum,$tsymb) = split(/\&/,$currtiny{$key}); |
|
unless (($coursetiny->{$tsymb} eq $key) || ($addcourse->{$tsymb} eq $key) || ($courseonly->{$tsymb} eq $key)) { |
|
$courseonly->{$tsymb} = $key; |
|
} |
|
} else { |
|
$collisions{$possibles{$key}} = 1; |
|
} |
|
delete($possibles{$key}); |
|
} |
|
} |
|
foreach my $key (keys(%possibles)) { |
|
$newunique->{$key} = $possibles{$key}; |
|
my ($tcnum,$tsymb) = split(/\&/,$possibles{$key}); |
|
unless (($coursetiny->{$tsymb} eq $key) || ($addcourse->{$tsymb} eq $key) || ($courseonly->{$tsymb} eq $key)) { |
|
$addcourse->{$tsymb} = $key; |
|
} |
|
} |
|
} |
|
if (keys(%collisions)) { |
|
if ($init <5) { |
|
if (!$init) { |
|
$init = 1; |
|
} else { |
|
$init ++; |
|
} |
|
$init = &shorten_symbs($cdom,$init,$su,$coursetiny,\%collisions, |
|
$newunique,$addcourse,$courseonly,$failed); |
|
} else { |
|
foreach my $key (keys(%collisions)) { |
|
$failed->{$key} = 1; |
|
} |
|
} |
|
} |
|
return $init; |
|
} |
|
|
1; |
1; |
__END__; |
__END__; |
|
|