version 1.107.2.2, 2006/05/11 23:59:11
|
version 1.122, 2007/08/28 01:13:19
|
Line 33 package Apache::lonuserstate;
|
Line 33 package Apache::lonuserstate;
|
use strict; |
use strict; |
use HTML::TokeParser; |
use HTML::TokeParser; |
use Apache::lonnet; |
use Apache::lonnet; |
|
use Apache::lonlocal; |
use Apache::loncommon(); |
use Apache::loncommon(); |
use GDBM_File; |
use GDBM_File; |
use Apache::lonmsg; |
use Apache::lonmsg; |
Line 41 use Safe::Hole;
|
Line 42 use Safe::Hole;
|
use Opcode; |
use Opcode; |
use Apache::lonenc; |
use Apache::lonenc; |
use Fcntl qw(:flock); |
use Fcntl qw(:flock); |
|
use LONCAPA; |
|
|
|
|
# ---------------------------------------------------- Globals for this package |
# ---------------------------------------------------- Globals for this package |
|
|
Line 49 my %hash; # The big tied hash
|
Line 52 my %hash; # The big tied hash
|
my %parmhash;# The hash with the parameters |
my %parmhash;# The hash with the parameters |
my @cond; # Array with all of the conditions |
my @cond; # Array with all of the conditions |
my $errtext; # variable with all errors |
my $errtext; # variable with all errors |
my $retfurl; # variable with the very first URL in the course |
my $retfrid; # variable with the very first RID in the course |
|
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 %encurl; # URLs in this folder are supposed to be encrypted |
my %encurl; # URLs in this folder are supposed to be encrypted |
Line 103 sub processversionfile {
|
Line 107 sub processversionfile {
|
|
|
sub loadmap { |
sub loadmap { |
my $uri=shift; |
my $uri=shift; |
if ($hash{'map_pc_'.$uri}) { return; } |
if ($hash{'map_pc_'.$uri}) { |
|
$errtext.='<p class="LC_error">'. |
|
&mt('Multiple use of sequence/page [_1]! The course will not function properly.','<tt>'.$uri.'</tt>'). |
|
'</p>'; |
|
return; |
|
} |
$pc++; |
$pc++; |
my $lpc=$pc; |
my $lpc=$pc; |
$hash{'map_pc_'.$uri}=$lpc; |
$hash{'map_pc_'.$uri}=$lpc; |
Line 117 sub loadmap {
|
Line 125 sub loadmap {
|
|
|
unless (($fn=~/\.sequence$/) || |
unless (($fn=~/\.sequence$/) || |
($fn=~/\.page$/)) { |
($fn=~/\.page$/)) { |
$errtext.="Invalid map: $fn\n"; |
$errtext.=&mt("<br />Invalid map: <tt>[_1]</tt>",$fn); |
return; |
return; |
} |
} |
|
|
Line 277 sub loadmap {
|
Line 285 sub loadmap {
|
} |
} |
$name=~s/^.*_([^_]*)$/$1/; |
$name=~s/^.*_([^_]*)$/$1/; |
my $newparam= |
my $newparam= |
&Apache::lonnet::escape($token->[2]->{'type'}).':'. |
&escape($token->[2]->{'type'}).':'. |
&Apache::lonnet::escape($part.'.'.$name).'='. |
&escape($part.'.'.$name).'='. |
&Apache::lonnet::escape($token->[2]->{'value'}); |
&escape($token->[2]->{'value'}); |
if (defined($hash{'param_'.$referid})) { |
if (defined($hash{'param_'.$referid})) { |
$hash{'param_'.$referid}.='&'.$newparam; |
$hash{'param_'.$referid}.='&'.$newparam; |
} else { |
} else { |
$hash{'param_'.$referid}=''.$newparam; |
$hash{'param_'.$referid}=''.$newparam; |
} |
} |
if ($token->[2]->{'name'}=~/^parameter_(0_)*mapalias$/) { |
|
$hash{'mapalias_'.$token->[2]->{'value'}}=$referid; |
|
} |
|
if ($token->[2]->{'name'}=~/^parameter_(0_)*randompick$/) { |
if ($token->[2]->{'name'}=~/^parameter_(0_)*randompick$/) { |
$randompick{$referid}=$token->[2]->{'value'}; |
$randompick{$referid}=$token->[2]->{'value'}; |
} |
} |
if ($token->[2]->{'name'}=~/^parameter_(0_)*randompickseed$/) { |
if ($token->[2]->{'name'}=~/^parameter_(0_)*randompickseed$/) { |
$randompick{$referid}=$token->[2]->{'value'}; |
$randompickseed{$referid}=$token->[2]->{'value'}; |
} |
} |
if ($token->[2]->{'name'}=~/^parameter_(0_)*encrypturl$/) { |
if ($token->[2]->{'name'}=~/^parameter_(0_)*encrypturl$/) { |
if ($token->[2]->{'value'}=~/^yes$/i) { |
if ($token->[2]->{'value'}=~/^yes$/i) { |
Line 310 sub loadmap {
|
Line 315 sub loadmap {
|
} |
} |
|
|
} else { |
} else { |
$errtext.='Map not loaded: The file ('.$fn.') does not exist. '; |
$errtext.=&mt('<br />Map not loaded: The file <tt>[_1]</tt> does not exist.',$fn); |
|
} |
|
|
|
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); |
|
} |
|
} |
|
} |
|
|
|
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 342 sub simplify {
|
Line 369 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 357 sub traceroute {
|
Line 384 sub traceroute {
|
|
|
my $encrypt=&Apache::lonnet::EXT('resource.0.encrypturl',$symb); |
my $encrypt=&Apache::lonnet::EXT('resource.0.encrypturl',$symb); |
if ($encflag || lc($encrypt) eq 'yes') { $encurl{$rid}=1; } |
if ($encflag || lc($encrypt) eq 'yes') { $encurl{$rid}=1; } |
if (($retfurl eq '') && ($hash{'src_'.$rid}) |
if (($retfrid eq '') && ($hash{'src_'.$rid}) |
&& ($hash{'src_'.$rid}!~/\.sequence$/)) { |
&& ($hash{'src_'.$rid}!~/\.sequence$/)) { |
$retfurl=$hash{'src_'.$rid}.(($hash{'src_'.$rid}=~/\?/)?'&':'?'). |
$retfrid=$rid; |
'symb='.$symb; |
|
} |
} |
if (defined($hash{'conditions_'.$rid})) { |
if (defined($hash{'conditions_'.$rid})) { |
$hash{'conditions_'.$rid}=simplify( |
$hash{'conditions_'.$rid}=simplify( |
Line 390 sub traceroute {
|
Line 416 sub traceroute {
|
$further=simplify('('.'_'.$rid.')&('. |
$further=simplify('('.'_'.$rid.')&('. |
$hash{'condid_'.$hash{'undercond_'.$id}}.')'); |
$hash{'condid_'.$hash{'undercond_'.$id}}.')'); |
} else { |
} else { |
$errtext.='Undefined condition ID: ' |
$errtext.=&mt('<br />Undefined condition ID: [_1]',$hash{'undercond_'.$id}); |
.$hash{'undercond_'.$id}.'. '; |
|
} |
} |
} |
} |
$newsofar=&traceroute($further,$hash{'goesto_'.$id},$beenhere, |
$newsofar=&traceroute($further,$hash{'goesto_'.$id},$beenhere, |
Line 438 sub accinit {
|
Line 463 sub accinit {
|
foreach my $param (split(/\&/,$hash{$key})) { |
foreach my $param (split(/\&/,$hash{$key})) { |
my ($typename,$value)=split(/\=/,$param); |
my ($typename,$value)=split(/\=/,$param); |
my ($type,$name)=split(/\:/,$typename); |
my ($type,$name)=split(/\:/,$typename); |
$parmhash{$prefix.'.'.&Apache::lonnet::unescape($name)}= |
$parmhash{$prefix.'.'.&unescape($name)}= |
&Apache::lonnet::unescape($value); |
&unescape($value); |
$parmhash{$prefix.'.'.&Apache::lonnet::unescape($name).'.type'}= |
$parmhash{$prefix.'.'.&unescape($name).'.type'}= |
&Apache::lonnet::unescape($type); |
&unescape($type); |
} |
} |
} |
} |
} |
} |
Line 545 sub hiddenurls {
|
Line 570 sub hiddenurls {
|
sub readmap { |
sub readmap { |
my $short=shift; |
my $short=shift; |
$short=~s/^\///; |
$short=~s/^\///; |
my %cenv=&Apache::lonnet::coursedescription($short); |
my %cenv=&Apache::lonnet::coursedescription($short,{'freshen_cache'=>1}); |
my $fn=$cenv{'fn'}; |
my $fn=$cenv{'fn'}; |
my $uri; |
my $uri; |
$short=~s/\//\_/g; |
$short=~s/\//\_/g; |
unless ($uri=$cenv{'url'}) { |
unless ($uri=$cenv{'url'}) { |
&Apache::lonnet::logthis("<font color=blue>WARNING: ". |
&Apache::lonnet::logthis("<font color=blue>WARNING: ". |
"Could not load course $short.</font>"); |
"Could not load course $short.</font>"); |
return 'No course data available.'; |
return ('',&mt('No course data available.'));; |
} |
} |
@cond=('true:normal'); |
@cond=('true:normal'); |
|
|
Line 568 sub readmap {
|
Line 593 sub readmap {
|
undef %randompick; |
undef %randompick; |
undef %hiddenurl; |
undef %hiddenurl; |
undef %encurl; |
undef %encurl; |
$retfurl=''; |
$retfrid=''; |
if ($lock && (tie(%hash,'GDBM_File',"$fn.db",&GDBM_WRCREAT(),0640)) && |
if ($lock && (tie(%hash,'GDBM_File',"$fn.db",&GDBM_WRCREAT(),0640)) && |
(tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_WRCREAT(),0640))) { |
(tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_WRCREAT(),0640))) { |
%hash=(); |
%hash=(); |
%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); |
Line 586 sub readmap {
|
Line 612 sub readmap {
|
&Apache::lonnet::appenv("request.course.id" => $short, |
&Apache::lonnet::appenv("request.course.id" => $short, |
"request.course.fn" => $fn, |
"request.course.fn" => $fn, |
"request.course.uri" => $uri); |
"request.course.uri" => $uri); |
|
$env{'request.course.id'}=$short; |
&traceroute('0',$hash{'map_start_'.$uri},'&'); |
&traceroute('0',$hash{'map_start_'.$uri},'&'); |
&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 597 sub readmap {
|
Line 625 sub readmap {
|
} elsif ($key =~ /^(map_(?:start|finish|pc)_)(.*)/) { |
} elsif ($key =~ /^(map_(?:start|finish|pc)_)(.*)/) { |
my ($type, $url) = ($1,$2); |
my ($type, $url) = ($1,$2); |
my $value = $hash{$key}; |
my $value = $hash{$key}; |
delete($hash{$key}); |
|
$hash{$type.&putinversion($url)}=$value; |
$hash{$type.&putinversion($url)}=$value; |
} |
} |
} |
} |
Line 608 sub readmap {
|
Line 635 sub readmap {
|
} |
} |
# ----------------------------------------------- Close hashes to finally store |
# ----------------------------------------------- Close hashes to finally store |
# --------------------------------- Routine must pass this point, no early outs |
# --------------------------------- Routine must pass this point, no early outs |
|
$hash{'first_rid'}=$retfrid; |
|
my ($mapid,$resid)=split(/\./,$retfrid); |
|
$hash{'first_mapurl'}=$hash{'map_id_'.$mapid}; |
|
my $symb=&Apache::lonnet::encode_symb($hash{'map_id_'.$mapid},$resid,$hash{'src_'.$retfrid}); |
|
$retfurl=&add_get_param($hash{'src_'.$retfrid},{ 'symb' => $symb }); |
|
if ($hash{'encrypted_'.$retfrid}) { |
|
$retfurl=&Apache::lonenc::encrypted($retfurl,(&Apache::lonnet::allowed('adv') ne 'F')); |
|
} |
$hash{'first_url'}=$retfurl; |
$hash{'first_url'}=$retfurl; |
unless ((untie(%hash)) && (untie(%parmhash))) { |
unless ((untie(%hash)) && (untie(%parmhash))) { |
&Apache::lonnet::logthis("<font color=blue>WARNING: ". |
&Apache::lonnet::logthis("<font color=blue>WARNING: ". |
Line 682 sub evalstate {
|
Line 717 sub evalstate {
|
if (-e $fn) { |
if (-e $fn) { |
my @conditions=(); |
my @conditions=(); |
{ |
{ |
my $fh=Apache::File->new($fn); |
open(my $fh,"<$fn"); |
@conditions=<$fh>; |
@conditions=<$fh>; |
|
close($fh); |
} |
} |
my $safeeval = new Safe; |
my $safeeval = new Safe; |
my $safehole = new Safe::Hole; |
my $safehole = new Safe::Hole; |
Line 713 sub evalstate {
|
Line 749 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__ |
|
|