rat/lonuserstate.pm - diff

Return to lonuserstate.pm CVS log

Up to [LON-CAPA] / rat

Diff for /rat/lonuserstate.pm between versions 1.16 and 1.39

version 1.16, 2000/11/02 15:53:17	version 1.39, 2002/08/31 00:43:13
Line 1	Line 1
# The LearningOnline Network with CAPA	# The LearningOnline Network with CAPA
# Construct and maintain state and binary representation of course for user	# Construct and maintain state and binary representation of course for user
#	#
	# $Id$
	#
	# Copyright Michigan State University Board of Trustees
	#
	# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
	#
	# LON-CAPA is free software; you can redistribute it and/or modify
	# it under the terms of the GNU General Public License as published by
	# the Free Software Foundation; either version 2 of the License, or
	# (at your option) any later version.
	#
	# LON-CAPA is distributed in the hope that it will be useful,
	# but WITHOUT ANY WARRANTY; without even the implied warranty of
	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	# GNU General Public License for more details.
	#
	# You should have received a copy of the GNU General Public License
	# along with LON-CAPA; if not, write to the Free Software
	# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
	#
	# /home/httpd/html/adm/gpl.txt
	#
	# http://www.lon-capa.org/
	#
# (Server for RAT Maps	# (Server for RAT Maps
#	#
# (Edit Handler for RAT Maps	# (Edit Handler for RAT Maps
# (TeX Content Handler	# (TeX Content Handler
#	#
	# YEAR=2000
# 05/29/00,05/30 Gerd Kortemeyer)	# 05/29/00,05/30 Gerd Kortemeyer)
# 7/1 Gerd Kortemeyer)	# 7/1 Gerd Kortemeyer)
# 7/1,7/3,7/4,7/7,7/8,7/10 Gerd Kortemeyer)	# 7/1,7/3,7/4,7/7,7/8,7/10 Gerd Kortemeyer)
#	#
# 7/15,7/17,7/18,8/1,8/2,8/4,8/5,8/21,8/22,8/23,8/30,	# 7/15,7/17,7/18,8/1,8/2,8/4,8/5,8/21,8/22,8/23,8/30,
# 9/2,9/4,9/29,9/30,10/2,10/11,10/30,10/31,11/1,11/2 Gerd Kortemeyer	# 9/2,9/4,9/29,9/30,10/2,10/11,10/30,10/31,
	# 11/1,11/2,11/14,11/16,11/22,12/28,
	# YEAR=2001
	# 07/05/01,08/30,08/31 Gerd Kortemeyer
	# 12/16 Scott Harrison
	#
	###

package Apache::lonuserstate;	package Apache::lonuserstate;

	# ------------------------------------------------- modules used by this module
use strict;	use strict;
use Apache::Constants qw(:common :http);	use Apache::Constants qw(:common :http);
use Apache::File;	use Apache::File;
use HTML::TokeParser;	use HTML::TokeParser;
use Apache::lonnet();	use Apache::lonnet();
	use Apache::loncommon();
use GDBM_File;	use GDBM_File;
use Apache::lonmsg;	use Apache::lonmsg;
use Safe;	use Safe;
	use Safe::Hole;
use Opcode;	use Opcode;


# ---------------------------------------------------- Globals for this package	# ---------------------------------------------------- Globals for this package

my $pc; # Package counter	my $pc; # Package counter
my %hash; # The big tied hash	my %hash; # The big tied hash
	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 %randompick; # randomly picked resources
# --------------------------------------------------------- Loads map from disk	# --------------------------------------------------------- Loads map from disk

sub loadmap {	sub loadmap {
Line 44 sub loadmap {	Line 79 sub loadmap {
$hash{'map_pc_'.$uri}=$lpc;	$hash{'map_pc_'.$uri}=$lpc;
$hash{'map_id_'.$lpc}=$uri;	$hash{'map_id_'.$lpc}=$uri;

my $fn='/home/httpd/html'.$uri;	# Determine and check filename
	my $fn=&Apache::lonnet::filelocation('',$uri);

	my $ispage=($fn=~/\.page$/);

unless (($fn=~/\.sequence$/) \|\|	unless (($fn=~/\.sequence$/) \|\|
($fn=~/\.page$/)) {	($fn=~/\.page$/)) {
Line 52 sub loadmap {	Line 90 sub loadmap {
return OK;	return OK;
}	}

unless (-e $fn) {	my $instr=&Apache::lonnet::getfile($fn);
my $returned=Apache::lonnet::repcopy($fn);
unless ($returned eq OK) {	unless ($instr == -1) {
$errtext.="Could not import: $fn - ";
if ($returned eq HTTP_SERVICE_UNAVAILABLE) {	# Successfully got file, parse it
$errtext.="Server unavailable\n";
}
if ($returned eq HTTP_NOT_FOUND) {
$errtext.="File not found\n";
}
if ($returned eq FORBIDDEN) {
$errtext.="Access forbidden\n";
}
return OK;
}
}

if (-e $fn) {
my @content;
{
my $fh=Apache::File->new($fn);
@content=<$fh>;
}
my $instr=join('',@content);
my $parser = HTML::TokeParser->new(\$instr);	my $parser = HTML::TokeParser->new(\$instr);
my $token;	my $token;

Line 95 sub loadmap {	Line 115 sub loadmap {
$hash{'kind_'.$rid}='res';	$hash{'kind_'.$rid}='res';
$hash{'title_'.$rid}=$token->[2]->{'title'};	$hash{'title_'.$rid}=$token->[2]->{'title'};
my $turi=$token->[2]->{'src'};	my $turi=$token->[2]->{'src'};
	unless ($ispage) {
	$turi=~/\.(\w+)$/;
	my $embstyle=&Apache::loncommon::fileembstyle($1);
	if ($token->[2]->{'external'} eq 'true') {
	$turi=~s/^http\:\/\//\/adm\/wrapper\/ext\//;
	} else {
	my $embstyle=&Apache::loncommon::fileembstyle($1);
	if (($embstyle eq 'img') \|\| ($embstyle eq 'emb')
	\|\| ($turi=~/\/syllabus$/) \|\| ($turi=~/\/aboutme$/)) {
	$turi='/adm/wrapper'.$turi;
	}
	}
	}
$hash{'src_'.$rid}=$turi;	$hash{'src_'.$rid}=$turi;

if (defined($hash{'ids_'.$turi})) {	if (defined($hash{'ids_'.$turi})) {
Line 103 sub loadmap {	Line 136 sub loadmap {
$hash{'ids_'.$turi}=''.$rid;	$hash{'ids_'.$turi}=''.$rid;
}	}

if ($token->[2]->{'src'}=~/\/\//) {	if ($token->[2]->{'external'} eq 'true') {
$hash{'ext_'.$rid}='true:';	$hash{'ext_'.$rid}='true:';
} else {	} else {
$hash{'ext_'.$rid}='false:';	$hash{'ext_'.$rid}='false:';
Line 168 sub loadmap {	Line 201 sub loadmap {
} else {	} else {
$hash{'from_'.$goesto}=''.$linkid;	$hash{'from_'.$goesto}=''.$linkid;
}	}
	} elsif ($token->[1] eq 'param') {
	# ------------------------------------------------------------------- Parameter

	my $referid=$lpc.'.'.$token->[2]->{'to'};
	my $part=$token->[2]->{'part'};
	unless ($part) { $part=0; }
	my $newparam=
	&Apache::lonnet::escape($token->[2]->{'type'}).':'.
	&Apache::lonnet::escape($part.'.'.
	$token->[2]->{'name'}).'='.
	&Apache::lonnet::escape($token->[2]->{'value'});
	if (defined($hash{'param_'.$referid})) {
	$hash{'param_'.$referid}.='&'.$newparam;
	} else {
	$hash{'param_'.$referid}=''.$newparam;
	}
	if ($token->[2]->{'name'} eq 'parameter_mapalias') {
	$hash{'mapalias_'.$token->[2]->{'value'}}=$referid;
	}
	if ($token->[2]->{'name'} eq 'parameter_randompick') {
	$randompick{$referid}=$token->[2]->{'value'};
	}
}	}

}	}
Line 206 sub traceroute {	Line 261 sub traceroute {
$sofar=simplify($sofar);	$sofar=simplify($sofar);
unless ($beenhere=~/\&$rid\&/) {	unless ($beenhere=~/\&$rid\&/) {
$beenhere.=$rid.'&';	$beenhere.=$rid.'&';
	if (($retfurl eq '') && ($hash{'src_'.$rid})) {
	my ($mapid,$resid)=split(/\./,$rid);
	$retfurl=$hash{'src_'.$rid}.
	(($hash{'src_'.$rid}=~/\?/)?'&':'?').'symb='.
	&Apache::lonnet::symbclean(
	&Apache::lonnet::declutter($hash{'map_id_'.$mapid}).
	'___'.$resid.'___'.
	&Apache::lonnet::declutter($hash{'src_'.$rid}));
	}
if (defined($hash{'conditions_'.$rid})) {	if (defined($hash{'conditions_'.$rid})) {
$hash{'conditions_'.$rid}=simplify(	$hash{'conditions_'.$rid}=simplify(
'('.$hash{'conditions_'.$rid}.')\|('.$sofar.')');	'('.$hash{'conditions_'.$rid}.')\|('.$sofar.')');
Line 222 sub traceroute {	Line 286 sub traceroute {
}	}
}	}
if (defined($hash{'to_'.$rid})) {	if (defined($hash{'to_'.$rid})) {
map {	foreach (split(/\,/,$hash{'to_'.$rid})) {
my $further=$sofar;	my $further=$sofar;
if ($hash{'undercond_'.$_}) {	if ($hash{'undercond_'.$_}) {
if (defined($hash{'condid_'.$hash{'undercond_'.$_}})) {	if (defined($hash{'condid_'.$hash{'undercond_'.$_}})) {
Line 234 sub traceroute {	Line 298 sub traceroute {
}	}
}	}
&traceroute($further,$hash{'goesto_'.$_},$beenhere);	&traceroute($further,$hash{'goesto_'.$_},$beenhere);
} split(/\,/,$hash{'to_'.$rid});	}
}	}
}	}
}	}

# ------------------------------------------ Cascading conditions, quick access	# ------------------------------ Cascading conditions, quick access, parameters

sub accinit {	sub accinit {
my ($uri,$short,$fn)=@_;	my ($uri,$short,$fn)=@_;
Line 247 sub accinit {	Line 311 sub accinit {
my %captured=();	my %captured=();
my $condcounter=0;	my $condcounter=0;
$acchash{'acc.cond.'.$short.'.0'}=0;	$acchash{'acc.cond.'.$short.'.0'}=0;
map {	foreach (keys %hash) {
if ($_=~/^conditions/) {	if ($_=~/^conditions/) {
my $expr=$hash{$_};	my $expr=$hash{$_};
map {	foreach ($expr=~m/($\(\d+(?:\&\d+)+$(?:\\|$\d+(?:\&\d+)+$)+\))/g) {
my $sub=$_;	my $sub=$_;
my $orig=$_;	my $orig=$_;
$sub=~/$\((\d+\&(:?\d+\&))(?:\d+\&)+$(?:\\|$\1(?:\d+\&*)+$)+\)/;	$sub=~/$\((\d+\&(:?\d+\&))(?:\d+\&)+$(?:\\|$\1(?:\d+\&*)+$)+\)/;
Line 261 sub accinit {	Line 325 sub accinit {
$sub=simplify($sub);	$sub=simplify($sub);
$orig=~s/(\W)/\\$1/g;	$orig=~s/(\W)/\\$1/g;
$expr=~s/$orig/$sub/;	$expr=~s/$orig/$sub/;
} ($expr=~m/($\(\d+(?:\&\d+)+$(?:\\|$\d+(?:\&\d+)+$)+\))/g);	}
$hash{$_}=$expr;	$hash{$_}=$expr;
unless (defined($captured{$expr})) {	unless (defined($captured{$expr})) {
$condcounter++;	$condcounter++;
$captured{$expr}=$condcounter;	$captured{$expr}=$condcounter;
$acchash{'acc.cond.'.$short.'.'.$condcounter}=$expr;	$acchash{'acc.cond.'.$short.'.'.$condcounter}=$expr;
}	}
}	} elsif ($_=~/^param_(\d+)\.(\d+)/) {
} keys %hash;	my $prefix=&Apache::lonnet::declutter($hash{'map_id_'.$1}).
map {	'___'.$2.'___'.&Apache::lonnet::declutter($hash{'src_'.$1.'.'.$2});
	foreach (split(/\&/,$hash{$_})) {
	my ($typename,$value)=split(/\=/,$_);
	my ($type,$name)=split(/\:/,$typename);
	$parmhash{$prefix.'.'.&Apache::lonnet::unescape($name)}=
	&Apache::lonnet::unescape($value);
	$parmhash{$prefix.'.'.&Apache::lonnet::unescape($name).'.type'}=
	&Apache::lonnet::unescape($type);
	}
	}
	}
	foreach (keys %hash) {
if ($_=~/^ids/) {	if ($_=~/^ids/) {
map {	foreach (split(/\,/,$hash{$_})) {
my $resid=$_;	my $resid=$_;
my $uri=$hash{'src_'.$resid};	my $uri=$hash{'src_'.$resid};
	$uri=~s/^\/adm\/wrapper//;
my @uriparts=split(/\//,$uri);	my @uriparts=split(/\//,$uri);
my $urifile=$uriparts[$#uriparts];	my $urifile=$uriparts[$#uriparts];
$#uriparts--;	$#uriparts--;
my $uripath=join('/',@uriparts);	my $uripath=join('/',@uriparts);
$uripath=~s/^\/res\///;	$uripath=~s/^\/res\///;
	if ($uripath) {
my $uricond='0';	my $uricond='0';
if (defined($hash{'conditions_'.$resid})) {	if (defined($hash{'conditions_'.$resid})) {
$uricond=$captured{$hash{'conditions_'.$resid}};	$uricond=$captured{$hash{'conditions_'.$resid}};
Line 288 sub accinit {	Line 365 sub accinit {
if ($acchash{'acc.res.'.$short.'.'.$uripath}=~	if ($acchash{'acc.res.'.$short.'.'.$uripath}=~
/(\&$urifile\:[^\&]*)/) {	/(\&$urifile\:[^\&]*)/) {
my $replace=$1;	my $replace=$1;
	my $regexp=$replace;
	$regexp=~s/\\|/\\\\|/g;
$acchash{'acc.res.'.$short.'.'.$uripath}	$acchash{'acc.res.'.$short.'.'.$uripath}
=~s/$replace/$replace\\|$uricond/;	=~s/$regexp/$replace\\|$uricond/;
} else {	} else {
$acchash{'acc.res.'.$short.'.'.$uripath}.=	$acchash{'acc.res.'.$short.'.'.$uripath}.=
$urifile.':'.$uricond.'&';	$urifile.':'.$uricond.'&';
Line 297 sub accinit {	Line 376 sub accinit {
} else {	} else {
$acchash{'acc.res.'.$short.'.'.$uripath}=	$acchash{'acc.res.'.$short.'.'.$uripath}=
'&'.$urifile.':'.$uricond.'&';	'&'.$urifile.':'.$uricond.'&';
}	}
} split(/\,/,$hash{$_});	}
	}
}	}
} keys %hash;	}
	$acchash{'acc.res.'.$short.'.'}='&:0&';
my $courseuri=$uri;	my $courseuri=$uri;
$courseuri=~s/^\/res\///;	$courseuri=~s/^\/res\///;
&Apache::lonnet::delenv('(acc\.\|httpref\.)');	&Apache::lonnet::delenv('(acc\.\|httpref\.)');
Line 310 sub accinit {	Line 391 sub accinit {
"request.course.uri" => $courseuri);	"request.course.uri" => $courseuri);
}	}

	# ------------------------------------- Selectively delete from randompick maps

	sub pickrandom {
	my $randomoutentry='';
	foreach my $rid (keys %randompick) {
	my $rndpick=$randompick{$rid};
	my $mpc=$hash{'map_pc_'.$hash{'src_'.$rid}};
	# ------------------------------------------- put existing resources into array
	my @currentrids=();
	foreach (keys %hash) {
	if ($_=~/^src_($mpc\.\d+)/) {
	if ($hash{'src_'.$1}) { push @currentrids, $1; }
	}
	}
	next if ($#currentrids<$rndpick);
	# -------------------------------- randomly eliminate the ones that should stay
	srand(&Apache::lonnet::rndseed($rid)); # use rid instead of symb
	for (my $i=1;$i<=$rndpick;$i++) {
	while (1) {
	my $randomidx=int(rand($#currentrids+1));
	if ($currentrids[$randomidx]) {
	$currentrids[$randomidx]='';
	last;
	}
	}
	}
	# -------------------------------------------------------- delete the leftovers
	for (my $k=0; $k<=$#currentrids; $k++) {
	if ($currentrids[$k]) {
	$hash{'randomout_'.$currentrids[$k]}=1;
	my ($mapid,$resid)=split(/\./,$currentrids[$k]);
	$randomoutentry.='&'.
	&Apache::lonnet::symbclean(
	&Apache::lonnet::declutter($hash{'map_id_'.$mapid}).
	'___'.$resid.'___'.
	&Apache::lonnet::declutter($hash{'src_'.$currentrids[$k]})
	).'&';
	}
	}
	}
	if ($randomoutentry) {
	&Apache::lonnet::appenv('acc.randomout' => $randomoutentry);
	}
	}

# ---------------------------------------------------- Read map and all submaps	# ---------------------------------------------------- Read map and all submaps

sub readmap {	sub readmap {
Line 328 sub readmap {	Line 454 sub readmap {
unlink($fn.'.db');	unlink($fn.'.db');
unlink($fn.'_symb.db');	unlink($fn.'_symb.db');
unlink($fn.'.state');	unlink($fn.'.state');
if (tie(%hash,'GDBM_File',"$fn.db",&GDBM_WRCREAT,0640)) {	unlink($fn.'parms.db');
	undef %randompick;
	$retfurl='';
	if ((tie(%hash,'GDBM_File',"$fn.db",&GDBM_WRCREAT(),0640)) &&
	(tie(%parmhash,'GDBM_File',$fn.'_parms.db',&GDBM_WRCREAT(),0640))) {
%hash=();	%hash=();
	%parmhash=();
$errtext='';	$errtext='';
$pc=0;	$pc=0;
	my $furi=&Apache::lonnet::clutter($uri);
	$hash{'src_0.0'}=$furi;
	$hash{'title_0.0'}=&Apache::lonnet::metadata($uri,'title');
	$hash{'ids_'.$furi}='0.0';
	$hash{'is_map_0.0'}=1;
loadmap($uri);	loadmap($uri);
if (defined($hash{'map_start_'.$uri})) {	if (defined($hash{'map_start_'.$uri})) {
&traceroute('0',$hash{'map_start_'.$uri},'&');	&traceroute('0',$hash{'map_start_'.$uri},'&');
&accinit($uri,$short,$fn);	&accinit($uri,$short,$fn);
	&pickrandom();
}	}
unless (untie(%hash)) {	unless ((untie(%hash)) && (untie(%parmhash))) {
&Apache::lonnet::logthis("<font color=blue>WARNING: ".	&Apache::lonnet::logthis("<font color=blue>WARNING: ".
"Could not untie coursemap $fn for $uri.</font>");	"Could not untie coursemap $fn for $uri.</font>");
}	}
Line 355 sub readmap {	Line 492 sub readmap {
"Could not tie coursemap $fn for $uri.</font>");	"Could not tie coursemap $fn for $uri.</font>");
}	}
&Apache::lonmsg::author_res_msg($ENV{'request.course.uri'},$errtext);	&Apache::lonmsg::author_res_msg($ENV{'request.course.uri'},$errtext);
return $errtext;	return ($retfurl,$errtext);
}	}

# ------------------------------------------------------- Evaluate state string	# ------------------------------------------------------- Evaluate state string

sub evalstate {	sub evalstate {
my $safeeval = new Safe;
my $fn=$ENV{'request.course.fn'}.'.state';	my $fn=$ENV{'request.course.fn'}.'.state';
my $state='2';	my $state='2';
if (-e $fn) {	if (-e $fn) {
Line 370 sub evalstate {	Line 507 sub evalstate {
my $fh=Apache::File->new($fn);	my $fh=Apache::File->new($fn);
@conditions=<$fh>;	@conditions=<$fh>;
}	}
	my $safeeval = new Safe;
	my $safehole = new Safe::Hole;
$safeeval->permit("entereval");	$safeeval->permit("entereval");
$safeeval->permit(":base_math");	$safeeval->permit(":base_math");
$safeeval->deny(":base_io");	$safeeval->deny(":base_io");
$safeeval->share_from('Apache::lonnet',['&varval']);	$safehole->wrap(\&Apache::lonnet::EXT,$safeeval,'&EXT');
map {	foreach (@conditions) {
my $line=$_;	my $line=$_;
chomp($line);	chomp($line);
my ($condition,$weight)=split(/\:/,$_);	my ($condition,$weight)=split(/\:/,$_);
$condition=~s/\[([\w\.]+)\]/\&varval$\'$1\'$/g;
if ($safeeval->reval($condition)) {	if ($safeeval->reval($condition)) {
if ($weight eq 'force') {	if ($weight eq 'force') {
$state.='3';	$state.='3';
Line 392 sub evalstate {	Line 530 sub evalstate {
$state.='1';	$state.='1';
}	}
}	}
} @conditions;	}
}	}
&Apache::lonnet::appenv('user.state.'.$ENV{'request.course.id'} => $state);	&Apache::lonnet::appenv('user.state.'.$ENV{'request.course.id'} => $state);
return $state;	return $state;
Line 401 sub evalstate {	Line 539 sub evalstate {
1;	1;
__END__	__END__

	=head1 NAME

	Apache::lonuserstate - Construct and maintain state and binary representation
	of course for user

	=head1 SYNOPSIS

	Invoked by lonroles.pm.

	&Apache::lonuserstate::readmap($cdom.'/'.$cnum);

	=head1 INTRODUCTION

	This module constructs and maintains state and binary representation
	of course for user.

	This is part of the LearningOnline Network with CAPA project
	described at http://www.lon-capa.org.

	=head1 HANDLER SUBROUTINE

	There is no handler subroutine.

	=head1 OTHER SUBROUTINES

	=over 4

	=item *

	loadmap() : Loads map from disk

	=item *

	simplify() : Simplify expression

	=item *

	traceroute() : Build condition hash

	=item *

	accinit() : Cascading conditions, quick access, parameters

	=item *

	readmap() : Read map and all submaps

	=item *

	evalstate() : Evaluate state string

	=back

	=cut

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

Removed from v.1.16
changed lines
	Added in v.1.39