version 1.117, 2006/06/30 04:23:25
|
version 1.124, 2007/08/29 00:50:50
|
Line 56 my $retfrid; # variable with the very fi
|
Line 56 my $retfrid; # variable with the very fi
|
my $retfurl; # first URL |
my $retfurl; # first URL |
my %randompick; # randomly picked resources |
my %randompick; # randomly picked resources |
my %randompickseed; # optional seed for randomly picking resources |
my %randompickseed; # optional seed for randomly picking resources |
|
my %randomorder; # maps to order contents randomly |
my %encurl; # URLs in this folder are supposed to be encrypted |
my %encurl; # URLs in this folder are supposed to be encrypted |
my %hiddenurl; # this URL (or complete folder) is supposed to be hidden |
my %hiddenurl; # this URL (or complete folder) is supposed to be hidden |
|
|
Line 106 sub processversionfile {
|
Line 107 sub processversionfile {
|
# --------------------------------------------------------- Loads map from disk |
# --------------------------------------------------------- Loads map from disk |
|
|
sub loadmap { |
sub loadmap { |
my $uri=shift; |
my ($uri,$parent_rid)=@_; |
if ($hash{'map_pc_'.$uri}) { |
if ($hash{'map_pc_'.$uri}) { |
$errtext.=&mt('<br />Multiple use of sequence/page <tt>[_1]</tt>! The course will not function properly.',$uri); |
$errtext.='<p class="LC_error">'. |
|
&mt('Multiple use of sequence/page [_1]! The course will not function properly.','<tt>'.$uri.'</tt>'). |
|
'</p>'; |
return; |
return; |
} |
} |
$pc++; |
$pc++; |
Line 129 sub loadmap {
|
Line 132 sub loadmap {
|
|
|
my $instr=&Apache::lonnet::getfile($fn); |
my $instr=&Apache::lonnet::getfile($fn); |
|
|
unless ($instr eq -1) { |
if ($instr eq -1) { |
|
$errtext.=&mt('<br />Map not loaded: The file <tt>[_1]</tt> does not exist.',$fn); |
|
return; |
|
} |
|
|
# Successfully got file, parse it |
# Successfully got file, parse it |
|
|
my $parser = HTML::TokeParser->new(\$instr); |
my $parser = HTML::TokeParser->new(\$instr); |
$parser->attr_encoded(1); |
$parser->attr_encoded(1); |
my $token; |
# first get all parameters |
|
while (my $token = $parser->get_token) { |
my $linkpc=0; |
next if ($token->[0] ne 'S'); |
|
if ($token->[1] eq 'param') { |
|
&parse_param($token,$lpc); |
|
} |
|
} |
|
#reset parser |
|
$parser = HTML::TokeParser->new(\$instr); |
|
$parser->attr_encoded(1); |
|
|
|
my $linkpc=0; |
|
|
|
$fn=~/\.(\w+)$/; |
|
|
|
$hash{'map_type_'.$lpc}=$1; |
|
|
|
my $randomize = ($randomorder{$parent_rid} =~ /^yes$/i); |
|
|
|
my @map_ids; |
|
while (my $token = $parser->get_token) { |
|
next if ($token->[0] ne 'S'); |
|
if ($token->[1] eq 'resource') { |
|
push(@map_ids,&parse_resource($token,$lpc,$ispage,$uri)); |
|
} elsif ($token->[1] eq 'link' && !$randomize) { |
|
# ----------------------------------------------------------------------- Links |
|
&make_link(++$linkpc,$lpc,$token->[2]->{'to'}, |
|
$token->[2]->{'from'}, |
|
$token->[2]->{'condition'}); |
|
} elsif ($token->[1] eq 'condition' && !$randomize) { |
|
&parse_condition($token,$lpc); |
|
} |
|
} |
|
|
$fn=~/\.(\w+)$/; |
if ($randomize) { |
|
if (!$env{'request.role.adv'}) { |
|
my $seed; |
|
if (defined($randompickseed{$parent_rid})) { |
|
$seed = $randompickseed{$parent_rid}; |
|
} else { |
|
my ($mapid,$resid)=split(/\./,$parent_rid); |
|
my $symb= |
|
&Apache::lonnet::encode_symb($hash{'map_id_'.$mapid}, |
|
$resid,$hash{'src_'.$parent_rid}); |
|
|
|
$seed = $symb; |
|
} |
|
|
|
my $rndseed=&Apache::lonnet::rndseed($seed); |
|
&Apache::lonnet::setup_random_from_rndseed($rndseed); |
|
@map_ids=&Math::Random::random_permutation(@map_ids); |
|
} |
|
my $from = shift(@map_ids); |
|
my $from_rid = $lpc.'.'.$from; |
|
$hash{'map_start_'.$uri} = $from_rid; |
|
$hash{'type_'.$from_rid}='start'; |
|
|
|
while (my $to = shift(@map_ids)) { |
|
&make_link(++$linkpc,$lpc,$to,$from); |
|
my $to_rid = $lpc.'.'.$to; |
|
$hash{'type_'.$to_rid}='normal'; |
|
$from = $to; |
|
$from_rid = $to_rid; |
|
} |
|
|
|
$hash{'map_finish_'.$uri}= $from_rid; |
|
$hash{'type_'.$from_rid}='finish'; |
|
} |
|
|
|
my $parser = HTML::TokeParser->new(\$instr); |
|
$parser->attr_encoded(1); |
|
# last parse out the mapalias params so as to ignore anything |
|
# refering to non-existant resources |
|
while (my $token = $parser->get_token) { |
|
next if ($token->[0] ne 'S'); |
|
if ($token->[1] eq 'param') { |
|
&parse_mapalias_param($token,$lpc); |
|
} |
|
} |
|
} |
|
|
$hash{'map_type_'.$lpc}=$1; |
|
|
|
while ($token = $parser->get_token) { |
|
if ($token->[0] eq 'S') { |
|
if ($token->[1] eq 'resource') { |
|
# -------------------------------------------------------------------- Resource |
# -------------------------------------------------------------------- Resource |
if ($token->[2]->{'type'} eq 'zombie') { next; } |
sub parse_resource { |
my $rid=$lpc.'.'.$token->[2]->{'id'}; |
my ($token,$lpc,$ispage,$uri) = @_; |
|
if ($token->[2]->{'type'} eq 'zombie') { next; } |
$hash{'kind_'.$rid}='res'; |
my $rid=$lpc.'.'.$token->[2]->{'id'}; |
$hash{'title_'.$rid}=$token->[2]->{'title'}; |
|
my $turi=&versiontrack($token->[2]->{'src'}); |
$hash{'kind_'.$rid}='res'; |
if ($token->[2]->{'version'}) { |
$hash{'title_'.$rid}=$token->[2]->{'title'}; |
unless ($hash{'version_'.$turi}) { |
my $turi=&versiontrack($token->[2]->{'src'}); |
$hash{'version_'.$turi}=$1; |
if ($token->[2]->{'version'}) { |
} |
unless ($hash{'version_'.$turi}) { |
} |
$hash{'version_'.$turi}=$1; |
my $title=$token->[2]->{'title'}; |
} |
$title=~s/\&colon\;/\:/gs; |
} |
# my $symb=&Apache::lonnet::encode_symb($uri, |
my $title=$token->[2]->{'title'}; |
# $token->[2]->{'id'}, |
$title=~s/\&colon\;/\:/gs; |
# $turi); |
# my $symb=&Apache::lonnet::encode_symb($uri, |
# &Apache::lonnet::do_cache_new('title',$symb,$title); |
# $token->[2]->{'id'}, |
unless ($ispage) { |
# $turi); |
$turi=~/\.(\w+)$/; |
# &Apache::lonnet::do_cache_new('title',$symb,$title); |
my $embstyle=&Apache::loncommon::fileembstyle($1); |
unless ($ispage) { |
if ($token->[2]->{'external'} eq 'true') { # external |
$turi=~/\.(\w+)$/; |
$turi=~s/^http\:\/\//\/adm\/wrapper\/ext\//; |
my $embstyle=&Apache::loncommon::fileembstyle($1); |
} elsif ($turi=~/^\/*uploaded\//) { # uploaded |
if ($token->[2]->{'external'} eq 'true') { # external |
if (($embstyle eq 'img') |
$turi=~s/^http\:\/\//\/adm\/wrapper\/ext\//; |
|| ($embstyle eq 'emb') |
} elsif ($turi=~/^\/*uploaded\//) { # uploaded |
|| ($embstyle eq 'wrp')) { |
if (($embstyle eq 'img') |
$turi='/adm/wrapper'.$turi; |
|| ($embstyle eq 'emb') |
} elsif ($embstyle eq 'ssi') { |
|| ($embstyle eq 'wrp')) { |
#do nothing with these |
$turi='/adm/wrapper'.$turi; |
} elsif ($turi!~/\.(sequence|page)$/) { |
} elsif ($embstyle eq 'ssi') { |
$turi='/adm/coursedocs/showdoc'.$turi; |
#do nothing with these |
} |
} elsif ($turi!~/\.(sequence|page)$/) { |
} elsif ($turi=~/\S/) { # normal non-empty internal resource |
$turi='/adm/coursedocs/showdoc'.$turi; |
my $mapdir=$uri; |
} |
$mapdir=~s/[^\/]+$//; |
} elsif ($turi=~/\S/) { # normal non-empty internal resource |
$turi=&Apache::lonnet::hreflocation($mapdir,$turi); |
my $mapdir=$uri; |
if (($embstyle eq 'img') |
$mapdir=~s/[^\/]+$//; |
|| ($embstyle eq 'emb') |
$turi=&Apache::lonnet::hreflocation($mapdir,$turi); |
|| ($embstyle eq 'wrp')) { |
if (($embstyle eq 'img') |
$turi='/adm/wrapper'.$turi; |
|| ($embstyle eq 'emb') |
} |
|| ($embstyle eq 'wrp')) { |
} |
$turi='/adm/wrapper'.$turi; |
} |
} |
|
} |
|
} |
# Store reverse lookup, remove query string |
# Store reverse lookup, remove query string |
my $idsuri=$turi; |
my $idsuri=$turi; |
$idsuri=~s/\?.+$//; |
$idsuri=~s/\?.+$//; |
if (defined($hash{'ids_'.$idsuri})) { |
if (defined($hash{'ids_'.$idsuri})) { |
$hash{'ids_'.$idsuri}.=','.$rid; |
$hash{'ids_'.$idsuri}.=','.$rid; |
} else { |
} else { |
$hash{'ids_'.$idsuri}=''.$rid; |
$hash{'ids_'.$idsuri}=''.$rid; |
} |
} |
|
|
if ($turi=~/\/(syllabus|aboutme|navmaps|smppg|grppg|bulletinboard)$/) { |
if ($turi=~/\/(syllabus|aboutme|navmaps|smppg|bulletinboard)$/) { |
$turi.='?register=1'; |
$turi.='?register=1'; |
} |
} |
|
|
$hash{'src_'.$rid}=$turi; |
$hash{'src_'.$rid}=$turi; |
|
|
if ($token->[2]->{'external'} eq 'true') { |
if ($token->[2]->{'external'} eq 'true') { |
$hash{'ext_'.$rid}='true:'; |
$hash{'ext_'.$rid}='true:'; |
} else { |
} else { |
$hash{'ext_'.$rid}='false:'; |
$hash{'ext_'.$rid}='false:'; |
} |
} |
if ($token->[2]->{'type'}) { |
if ($token->[2]->{'type'}) { |
$hash{'type_'.$rid}=$token->[2]->{'type'}; |
$hash{'type_'.$rid}=$token->[2]->{'type'}; |
if ($token->[2]->{'type'} eq 'start') { |
if ($token->[2]->{'type'} eq 'start') { |
$hash{'map_start_'.$uri}="$rid"; |
$hash{'map_start_'.$uri}="$rid"; |
} |
} |
if ($token->[2]->{'type'} eq 'finish') { |
if ($token->[2]->{'type'} eq 'finish') { |
$hash{'map_finish_'.$uri}="$rid"; |
$hash{'map_finish_'.$uri}="$rid"; |
} |
} |
} else { |
} else { |
$hash{'type_'.$rid}='normal'; |
$hash{'type_'.$rid}='normal'; |
} |
} |
|
|
if (($turi=~/\.sequence$/) || |
if (($turi=~/\.sequence$/) || |
($turi=~/\.page$/)) { |
($turi=~/\.page$/)) { |
$hash{'is_map_'.$rid}=1; |
$hash{'is_map_'.$rid}=1; |
&loadmap($turi); |
&loadmap($turi,$rid); |
} |
} |
|
return $token->[2]->{'id'}; |
} elsif ($token->[1] eq 'condition') { |
} |
# ------------------------------------------------------------------- Condition |
|
|
|
my $rid=$lpc.'.'.$token->[2]->{'id'}; |
|
|
|
$hash{'kind_'.$rid}='cond'; |
sub make_link { |
$cond[$#cond+1]=$token->[2]->{'value'}; |
my ($linkpc,$lpc,$to,$from,$condition) = @_; |
$hash{'condid_'.$rid}=$#cond; |
|
if ($token->[2]->{'type'}) { |
my $linkid=$lpc.'.'.$linkpc; |
$cond[$#cond].=':'.$token->[2]->{'type'}; |
my $goesto=$lpc.'.'.$to; |
} else { |
my $comesfrom=$lpc.'.'.$from; |
$cond[$#cond].=':normal'; |
my $undercond=0; |
} |
|
|
if ($condition) { |
|
$undercond=$lpc.'.'.$condition; |
|
} |
|
|
|
$hash{'goesto_'.$linkid}=$goesto; |
|
$hash{'comesfrom_'.$linkid}=$comesfrom; |
|
$hash{'undercond_'.$linkid}=$undercond; |
|
|
} elsif ($token->[1] eq 'link') { |
if (defined($hash{'to_'.$comesfrom})) { |
# ----------------------------------------------------------------------- Links |
$hash{'to_'.$comesfrom}.=','.$linkid; |
|
} else { |
|
$hash{'to_'.$comesfrom}=''.$linkid; |
|
} |
|
if (defined($hash{'from_'.$goesto})) { |
|
$hash{'from_'.$goesto}.=','.$linkid; |
|
} else { |
|
$hash{'from_'.$goesto}=''.$linkid; |
|
} |
|
} |
|
|
$linkpc++; |
# ------------------------------------------------------------------- Condition |
my $linkid=$lpc.'.'.$linkpc; |
sub parse_condition { |
|
my ($token,$lpc) = @_; |
|
my $rid=$lpc.'.'.$token->[2]->{'id'}; |
|
|
|
$hash{'kind_'.$rid}='cond'; |
|
|
|
my $condition = $token->[2]->{'value'}; |
|
$condition =~ s/[\n\r]+/ /gs; |
|
push(@cond, $condition); |
|
$hash{'condid_'.$rid}=$#cond; |
|
if ($token->[2]->{'type'}) { |
|
$cond[$#cond].=':'.$token->[2]->{'type'}; |
|
} else { |
|
$cond[$#cond].=':normal'; |
|
} |
|
} |
|
|
my $goesto=$lpc.'.'.$token->[2]->{'to'}; |
|
my $comesfrom=$lpc.'.'.$token->[2]->{'from'}; |
|
my $undercond=0; |
|
|
|
if ($token->[2]->{'condition'}) { |
|
$undercond=$lpc.'.'.$token->[2]->{'condition'}; |
|
} |
|
|
|
$hash{'goesto_'.$linkid}=$goesto; |
|
$hash{'comesfrom_'.$linkid}=$comesfrom; |
|
$hash{'undercond_'.$linkid}=$undercond; |
|
|
|
if (defined($hash{'to_'.$comesfrom})) { |
|
$hash{'to_'.$comesfrom}.=','.$linkid; |
|
} else { |
|
$hash{'to_'.$comesfrom}=''.$linkid; |
|
} |
|
if (defined($hash{'from_'.$goesto})) { |
|
$hash{'from_'.$goesto}.=','.$linkid; |
|
} else { |
|
$hash{'from_'.$goesto}=''.$linkid; |
|
} |
|
} elsif ($token->[1] eq 'param') { |
|
# ------------------------------------------------------------------- Parameter |
# ------------------------------------------------------------------- Parameter |
|
|
my $referid=$lpc.'.'.$token->[2]->{'to'}; |
sub parse_param { |
my $name=$token->[2]->{'name'}; |
my ($token,$lpc) = @_; |
my $part; |
my $referid=$lpc.'.'.$token->[2]->{'to'}; |
if ($name=~/^parameter_(.*)_/) { |
my $name=$token->[2]->{'name'}; |
$part=$1; |
my $part; |
} else { |
if ($name=~/^parameter_(.*)_/) { |
$part=0; |
$part=$1; |
} |
|
$name=~s/^.*_([^_]*)$/$1/; |
|
my $newparam= |
|
&escape($token->[2]->{'type'}).':'. |
|
&escape($part.'.'.$name).'='. |
|
&escape($token->[2]->{'value'}); |
|
if (defined($hash{'param_'.$referid})) { |
|
$hash{'param_'.$referid}.='&'.$newparam; |
|
} else { |
|
$hash{'param_'.$referid}=''.$newparam; |
|
} |
|
if ($token->[2]->{'name'}=~/^parameter_(0_)*mapalias$/) { |
|
$hash{'mapalias_'.$token->[2]->{'value'}}=$referid; |
|
} |
|
if ($token->[2]->{'name'}=~/^parameter_(0_)*randompick$/) { |
|
$randompick{$referid}=$token->[2]->{'value'}; |
|
} |
|
if ($token->[2]->{'name'}=~/^parameter_(0_)*randompickseed$/) { |
|
$randompick{$referid}=$token->[2]->{'value'}; |
|
} |
|
if ($token->[2]->{'name'}=~/^parameter_(0_)*encrypturl$/) { |
|
if ($token->[2]->{'value'}=~/^yes$/i) { |
|
$encurl{$referid}=1; |
|
} |
|
} |
|
if ($token->[2]->{'name'}=~/^parameter_(0_)*hiddenresource$/) { |
|
if ($token->[2]->{'value'}=~/^yes$/i) { |
|
$hiddenurl{$referid}=1; |
|
} |
|
} |
|
} |
|
|
|
} |
|
} |
|
|
|
} else { |
} else { |
$errtext.=&mt('<br />Map not loaded: The file <tt>[_1]</tt> does not exist.',$fn); |
$part=0; |
|
} |
|
$name=~s/^.*_([^_]*)$/$1/; |
|
my $newparam= |
|
&escape($token->[2]->{'type'}).':'. |
|
&escape($part.'.'.$name).'='. |
|
&escape($token->[2]->{'value'}); |
|
if (defined($hash{'param_'.$referid})) { |
|
$hash{'param_'.$referid}.='&'.$newparam; |
|
} else { |
|
$hash{'param_'.$referid}=''.$newparam; |
|
} |
|
if ($token->[2]->{'name'}=~/^parameter_(0_)*randompick$/) { |
|
$randompick{$referid}=$token->[2]->{'value'}; |
|
} |
|
if ($token->[2]->{'name'}=~/^parameter_(0_)*randompickseed$/) { |
|
$randompickseed{$referid}=$token->[2]->{'value'}; |
|
} |
|
if ($token->[2]->{'name'}=~/^parameter_(0_)*randomorder$/) { |
|
$randomorder{$referid}=$token->[2]->{'value'}; |
|
} |
|
if ($token->[2]->{'name'}=~/^parameter_(0_)*encrypturl$/) { |
|
if ($token->[2]->{'value'}=~/^yes$/i) { |
|
$encurl{$referid}=1; |
|
} |
|
} |
|
if ($token->[2]->{'name'}=~/^parameter_(0_)*hiddenresource$/) { |
|
if ($token->[2]->{'value'}=~/^yes$/i) { |
|
$hiddenurl{$referid}=1; |
|
} |
|
} |
|
} |
|
|
|
sub parse_mapalias_param { |
|
my ($token,$lpc) = @_; |
|
my $referid=$lpc.'.'.$token->[2]->{'to'}; |
|
return if (!exists($hash{'src_'.$referid})); |
|
|
|
if ($token->[2]->{'name'}=~/^parameter_(0_)*mapalias$/) { |
|
&count_mapalias($token->[2]->{'value'},$referid); |
|
$hash{'mapalias_'.$token->[2]->{'value'}}=$referid; |
} |
} |
} |
} |
|
|
Line 348 sub simplify {
|
Line 437 sub simplify {
|
sub traceroute { |
sub traceroute { |
my ($sofar,$rid,$beenhere,$encflag,$hdnflag)=@_; |
my ($sofar,$rid,$beenhere,$encflag,$hdnflag)=@_; |
my $newsofar=$sofar=simplify($sofar); |
my $newsofar=$sofar=simplify($sofar); |
unless ($beenhere=~/\&$rid\&/) { |
unless ($beenhere=~/\&\Q$rid\E\&/) { |
$beenhere.=$rid.'&'; |
$beenhere.=$rid.'&'; |
my ($mapid,$resid)=split(/\./,$rid); |
my ($mapid,$resid)=split(/\./,$rid); |
my $symb=&Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},$resid,$hash{'src_'.$rid}); |
my $symb=&Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},$resid,$hash{'src_'.$rid}); |
Line 579 sub readmap {
|
Line 668 sub readmap {
|
%parmhash=(); |
%parmhash=(); |
$errtext=''; |
$errtext=''; |
$pc=0; |
$pc=0; |
|
&clear_mapalias_count(); |
&processversionfile(%cenv); |
&processversionfile(%cenv); |
my $furi=&Apache::lonnet::clutter($uri); |
my $furi=&Apache::lonnet::clutter($uri); |
$hash{'src_0.0'}=&versiontrack($furi); |
$hash{'src_0.0'}=&versiontrack($furi); |
$hash{'title_0.0'}=&Apache::lonnet::metadata($uri,'title'); |
$hash{'title_0.0'}=&Apache::lonnet::metadata($uri,'title'); |
$hash{'ids_'.$furi}='0.0'; |
$hash{'ids_'.$furi}='0.0'; |
$hash{'is_map_0.0'}=1; |
$hash{'is_map_0.0'}=1; |
loadmap($uri); |
loadmap($uri,'0.0'); |
if (defined($hash{'map_start_'.$uri})) { |
if (defined($hash{'map_start_'.$uri})) { |
&Apache::lonnet::appenv("request.course.id" => $short, |
&Apache::lonnet::appenv("request.course.id" => $short, |
"request.course.fn" => $fn, |
"request.course.fn" => $fn, |
Line 595 sub readmap {
|
Line 685 sub readmap {
|
&accinit($uri,$short,$fn); |
&accinit($uri,$short,$fn); |
&hiddenurls(); |
&hiddenurls(); |
} |
} |
|
$errtext .= &get_mapalias_errors(); |
# ------------------------------------------------------- Put versions into src |
# ------------------------------------------------------- Put versions into src |
foreach my $key (keys(%hash)) { |
foreach my $key (keys(%hash)) { |
if ($key=~/^src_/) { |
if ($key=~/^src_/) { |
Line 726 sub evalstate {
|
Line 817 sub evalstate {
|
return $state; |
return $state; |
} |
} |
|
|
|
{ |
|
my %mapalias_cache; |
|
sub count_mapalias { |
|
my ($value,$resid) = @_; |
|
push(@{ $mapalias_cache{$value} }, $resid); |
|
} |
|
|
|
sub get_mapalias_errors { |
|
my $error_text; |
|
foreach my $mapalias (sort(keys(%mapalias_cache))) { |
|
next if (scalar(@{ $mapalias_cache{$mapalias} } ) == 1); |
|
my $count; |
|
my $which = |
|
join('</li><li>', |
|
map { |
|
my $id = $_; |
|
if (exists($hash{'src_'.$id})) { |
|
$count++; |
|
} |
|
my ($mapid) = split(/\./,$id); |
|
&mt('[_1] in [_2]', $hash{'title_'.$id}, |
|
|
|
$hash{'title_'.$hash{'ids_'.$hash{'map_id_'.$mapid}}}); |
|
} (@{ $mapalias_cache{$mapalias} })); |
|
next if ($count < 2); |
|
$error_text .= '<div class="LC_error">'. |
|
&mt('Error: Found the mapalias "[_1]" defined multiple times.', |
|
$mapalias). |
|
'</div><ul><li>'.$which.'</li></ul>'; |
|
} |
|
&clear_mapalias_count(); |
|
return $error_text; |
|
} |
|
sub clear_mapalias_count { |
|
undef(%mapalias_cache); |
|
} |
|
} |
1; |
1; |
__END__ |
__END__ |
|
|