version 1.523.2.2, 2004/09/15 20:41:07
|
version 1.524, 2004/07/22 23:08:44
|
Line 50 use Fcntl qw(:flock);
|
Line 50 use Fcntl qw(:flock);
|
use Apache::loncoursedata; |
use Apache::loncoursedata; |
use Apache::lonlocal; |
use Apache::lonlocal; |
use Storable qw(lock_store lock_nstore lock_retrieve freeze thaw); |
use Storable qw(lock_store lock_nstore lock_retrieve freeze thaw); |
use Time::HiRes qw( gettimeofday tv_interval ); |
use Time::HiRes(); |
my $readit; |
my $readit; |
|
|
=pod |
=pod |
Line 1047 sub currentversion {
|
Line 1047 sub currentversion {
|
sub subscribe { |
sub subscribe { |
my $fname=shift; |
my $fname=shift; |
if ($fname=~/\/(aboutme|syllabus|bulletinboard|smppg)$/) { return ''; } |
if ($fname=~/\/(aboutme|syllabus|bulletinboard|smppg)$/) { return ''; } |
$fname=~s/[\n\r]//g; |
|
my $author=$fname; |
my $author=$fname; |
$author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/; |
$author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/; |
my ($udom,$uname)=split(/\//,$author); |
my ($udom,$uname)=split(/\//,$author); |
Line 1068 sub repcopy {
|
Line 1067 sub repcopy {
|
my $filename=shift; |
my $filename=shift; |
$filename=~s/\/+/\//g; |
$filename=~s/\/+/\//g; |
if ($filename=~/^\/home\/httpd\/html\/adm\//) { return OK; } |
if ($filename=~/^\/home\/httpd\/html\/adm\//) { return OK; } |
$filename=~s/[\n\r]//g; |
|
my $transname="$filename.in.transfer"; |
my $transname="$filename.in.transfer"; |
if ((-e $filename) || (-e $transname)) { return OK; } |
if ((-e $filename) || (-e $transname)) { return OK; } |
my $remoteurl=subscribe($filename); |
my $remoteurl=subscribe($filename); |
Line 2593 sub put {
|
Line 2591 sub put {
|
return &reply("put:$udomain:$uname:$namespace:$items",$uhome); |
return &reply("put:$udomain:$uname:$namespace:$items",$uhome); |
} |
} |
|
|
|
# ---------------------------------------------------------- putstore interface |
|
|
|
sub putstore { |
|
my ($namespace,$storehash,$udomain,$uname)=@_; |
|
if (!$udomain) { $udomain=$ENV{'user.domain'}; } |
|
if (!$uname) { $uname=$ENV{'user.name'}; } |
|
my $uhome=&homeserver($uname,$udomain); |
|
my $items=''; |
|
my %allitems = (); |
|
foreach (keys %$storehash) { |
|
if ($_ =~ m/^([^\:]+):([^\:]+):([^\:]+)$/) { |
|
my $key = $1.':keys:'.$2; |
|
$allitems{$key} .= $3.':'; |
|
} |
|
$items.=$_.'='.&escape($$storehash{$_}).'&'; |
|
} |
|
foreach (keys %allitems) { |
|
$allitems{$_} =~ s/\:$//; |
|
$items.= $_.'='.$allitems{$_}.'&'; |
|
} |
|
$items=~s/\&$//; |
|
return &reply("put:$udomain:$uname:$namespace:$items",$uhome); |
|
} |
|
|
# ------------------------------------------------------ critical put interface |
# ------------------------------------------------------ critical put interface |
|
|
sub cput { |
sub cput { |
Line 3996 sub EXT {
|
Line 4018 sub EXT {
|
|
|
my $section; |
my $section; |
if (defined($courseid) && $courseid eq $ENV{'request.course.id'}) { |
if (defined($courseid) && $courseid eq $ENV{'request.course.id'}) { |
if (!$symbparm) { $symbparm=&symbread(); } |
|
} |
|
if ($symbparm && defined($courseid) && |
|
$courseid eq $ENV{'request.course.id'}) { |
|
|
|
#print '<br>'.$space.' - '.$qualifier.' - '.$spacequalifierrest; |
#print '<br>'.$space.' - '.$qualifier.' - '.$spacequalifierrest; |
|
|
# ----------------------------------------------------- Cascading lookup scheme |
# ----------------------------------------------------- Cascading lookup scheme |
|
if (!$symbparm) { $symbparm=&symbread(); } |
my $symbp=$symbparm; |
my $symbp=$symbparm; |
my $mapp=(&decode_symb($symbp))[0]; |
my $mapp=(&decode_symb($symbp))[0]; |
|
|
Line 4014 sub EXT {
|
Line 4033 sub EXT {
|
($ENV{'user.domain'} eq $udom)) { |
($ENV{'user.domain'} eq $udom)) { |
$section=$ENV{'request.course.sec'}; |
$section=$ENV{'request.course.sec'}; |
} else { |
} else { |
if (! defined($usection)) { |
if (! defined($usection)) { |
$section=&usection($udom,$uname,$courseid); |
$section=&usection($udom,$uname,$courseid); |
} else { |
} else { |
$section = $usection; |
$section = $usection; |
} |
} |
} |
} |
|
|
my $seclevel=$courseid.'.['.$section.'].'.$spacequalifierrest; |
my $seclevel=$courseid.'.['.$section.'].'.$spacequalifierrest; |
Line 4056 sub EXT {
|
Line 4075 sub EXT {
|
$uname." at ".$udom.": ". |
$uname." at ".$udom.": ". |
$tmp."</font>"); |
$tmp."</font>"); |
} elsif ($tmp=~/error: 2 /) { |
} elsif ($tmp=~/error: 2 /) { |
&EXT_cache_set($udom,$uname); |
&EXT_cache_set($udom,$uname); |
} elsif ($tmp =~ /^(con_lost|no_such_host)/) { |
} elsif ($tmp =~ /^(con_lost|no_such_host)/) { |
return $tmp; |
return $tmp; |
} |
} |
Line 4066 sub EXT {
|
Line 4085 sub EXT {
|
# -------------------------------------------------------- second, check course |
# -------------------------------------------------------- second, check course |
|
|
my $coursereply=&courseresdata($ENV{'course.'.$courseid.'.num'}, |
my $coursereply=&courseresdata($ENV{'course.'.$courseid.'.num'}, |
$ENV{'course.'.$courseid.'.domain'}, |
$ENV{'course.'.$courseid.'.domain'}, |
($seclevelr,$seclevelm,$seclevel, |
($seclevelr,$seclevelm,$seclevel, |
$courselevelr,$courselevelm, |
$courselevelr,$courselevelm, |
$courselevel)); |
$courselevel)); |
if (defined($coursereply)) { return $coursereply; } |
if (defined($coursereply)) { return $coursereply; } |
|
|
# ------------------------------------------------------ third, check map parms |
# ------------------------------------------------------ third, check map parms |
Line 4567 sub deversion {
|
Line 4586 sub deversion {
|
|
|
sub symbread { |
sub symbread { |
my ($thisfn,$donotrecurse)=@_; |
my ($thisfn,$donotrecurse)=@_; |
if (defined($ENV{'request.symbread.cached'})) { |
|
return $ENV{'request.symbread.cached'}; |
|
} |
|
# no filename provided? try from environment |
# no filename provided? try from environment |
unless ($thisfn) { |
unless ($thisfn) { |
if ($ENV{'request.symb'}) { |
if ($ENV{'request.symb'}) { return &symbclean($ENV{'request.symb'}); } |
$ENV{'request.symbread.cached'}=&symbclean($ENV{'request.symb'}); |
|
return $ENV{'request.symbread.cached'}; |
|
} |
|
$thisfn=$ENV{'request.filename'}; |
$thisfn=$ENV{'request.filename'}; |
} |
} |
# is that filename actually a symb? Verify, clean, and return |
# is that filename actually a symb? Verify, clean, and return |
if ($thisfn=~/\_\_\_\d+\_\_\_(.*)$/) { |
if ($thisfn=~/\_\_\_\d+\_\_\_(.*)$/) { |
if (&symbverify($thisfn,$1)) { |
if (&symbverify($thisfn,$1)) { return &symbclean($thisfn); } |
$ENV{'request.symbread.cached'}=&symbclean($thisfn); |
|
return $ENV{'request.symbread.cached'}; |
|
} |
|
} |
} |
$thisfn=declutter($thisfn); |
$thisfn=declutter($thisfn); |
my %hash; |
my %hash; |
Line 4604 sub symbread {
|
Line 4614 sub symbread {
|
unless ($syval=~/\_\d+$/) { |
unless ($syval=~/\_\d+$/) { |
unless ($ENV{'form.request.prefix'}=~/\.(\d+)\_$/) { |
unless ($ENV{'form.request.prefix'}=~/\.(\d+)\_$/) { |
&appenv('request.ambiguous' => $thisfn); |
&appenv('request.ambiguous' => $thisfn); |
$ENV{'request.symbread.cached'}=''; |
|
return ''; |
return ''; |
} |
} |
$syval.=$1; |
$syval.=$1; |
Line 4652 sub symbread {
|
Line 4661 sub symbread {
|
} |
} |
} |
} |
if ($syval) { |
if ($syval) { |
$ENV{'request.symbread.cached'}=&symbclean($syval.'___'.$thisfn); |
return &symbclean($syval.'___'.$thisfn); |
return $ENV{'request.symbread.cached'}; |
|
} |
} |
} |
} |
&appenv('request.ambiguous' => $thisfn); |
&appenv('request.ambiguous' => $thisfn); |
$ENV{'request.symbread.cached'}=''; |
|
return ''; |
return ''; |
} |
} |
|
|
Line 5935 put($namespace,$storehash,$udom,$uname)
|
Line 5942 put($namespace,$storehash,$udom,$uname)
|
|
|
=item * |
=item * |
|
|
|
putstore($namespace,$storehash,$udomain,$uname) : stores hash in namesp |
|
keys used in storehash include version information (e.g., 1:$symb:message etc.) as |
|
used in records written by &store and retrieved by &restore. This function |
|
was created for use in editing discussion posts, without incrementing the |
|
version number included in the key for a particular post. The colon |
|
separated list of attribute names (e.g., the value associated with the key |
|
1:keys:$symb) is also generated and passed in the ampersand separated |
|
items sent to lonnet::reply(). |
|
|
|
=item * |
|
|
cput($namespace,$storehash,$udom,$uname) : critical put |
cput($namespace,$storehash,$udom,$uname) : critical put |
($udom and $uname are optional) |
($udom and $uname are optional) |
|
|