version 1.726, 2006/04/06 19:14:50
|
version 1.740, 2006/05/30 12:47:18
|
Line 45 qw(%perlvar %hostname %badServerCache %i
|
Line 45 qw(%perlvar %hostname %badServerCache %i
|
|
|
use IO::Socket; |
use IO::Socket; |
use GDBM_File; |
use GDBM_File; |
use Apache::Constants qw(:common :http); |
|
use HTML::LCParser; |
use HTML::LCParser; |
use HTML::Parser; |
use HTML::Parser; |
use Fcntl qw(:flock); |
use Fcntl qw(:flock); |
Line 53 use Storable qw(lock_store lock_nstore l
|
Line 52 use Storable qw(lock_store lock_nstore l
|
use Time::HiRes qw( gettimeofday tv_interval ); |
use Time::HiRes qw( gettimeofday tv_interval ); |
use Cache::Memcached; |
use Cache::Memcached; |
use Digest::MD5; |
use Digest::MD5; |
|
use lib '/home/httpd/lib/perl'; |
|
use LONCAPA; |
|
use LONCAPA::Configuration; |
|
|
my $readit; |
my $readit; |
my $max_connection_retries = 10; # Or some such value. |
my $max_connection_retries = 10; # Or some such value. |
Line 86 delayed.
|
Line 88 delayed.
|
|
|
|
|
# --------------------------------------------------------------------- Logging |
# --------------------------------------------------------------------- Logging |
|
{ |
|
my $logid; |
|
sub instructor_log { |
|
my ($hash_name,$storehash,$delflag,$uname,$udom)=@_; |
|
$logid++; |
|
my $id=time().'00000'.$$.'00000'.$logid; |
|
return &Apache::lonnet::put('nohist_'.$hash_name, |
|
{ $id => { |
|
'exe_uname' => $env{'user.name'}, |
|
'exe_udom' => $env{'user.domain'}, |
|
'exe_time' => time(), |
|
'exe_ip' => $ENV{'REMOTE_ADDR'}, |
|
'delflag' => $delflag, |
|
'logentry' => $storehash, |
|
'uname' => $uname, |
|
'udom' => $udom, |
|
} |
|
}, |
|
$env{'course.'.$env{'request.course.id'}.'.domain'}, |
|
$env{'course.'.$env{'request.course.id'}.'.num'} |
|
); |
|
} |
|
} |
|
|
sub logtouch { |
sub logtouch { |
my $execdir=$perlvar{'lonDaemons'}; |
my $execdir=$perlvar{'lonDaemons'}; |
Line 852 sub getsection {
|
Line 877 sub getsection {
|
} |
} |
|
|
sub save_cache { |
sub save_cache { |
my ($r)=@_; |
|
if (! $r->is_initial_req()) { return DECLINED; } |
|
&purge_remembered(); |
&purge_remembered(); |
#&Apache::loncommon::validate_page(); |
#&Apache::loncommon::validate_page(); |
undef(%env); |
undef(%env); |
return OK; |
|
} |
} |
|
|
my $to_remember=-1; |
my $to_remember=-1; |
Line 1933 sub courseiddump {
|
Line 1955 sub courseiddump {
|
sub dcmailput { |
sub dcmailput { |
my ($domain,$msgid,$message,$server)=@_; |
my ($domain,$msgid,$message,$server)=@_; |
my $status = &Apache::lonnet::critical( |
my $status = &Apache::lonnet::critical( |
'dcmailput:'.$domain.':'.&Apache::lonnet::escape($msgid).'='. |
'dcmailput:'.$domain.':'.&escape($msgid).'='. |
&Apache::lonnet::escape($message),$server); |
&escape($message),$server); |
return $status; |
return $status; |
} |
} |
|
|
Line 2581 sub restore {
|
Line 2603 sub restore {
|
# ---------------------------------------------------------- Course Description |
# ---------------------------------------------------------- Course Description |
|
|
sub coursedescription { |
sub coursedescription { |
my $courseid=shift; |
my ($courseid,$args)=@_; |
$courseid=~s/^\///; |
$courseid=~s/^\///; |
$courseid=~s/\_/\//g; |
$courseid=~s/\_/\//g; |
my ($cdomain,$cnum)=split(/\//,$courseid); |
my ($cdomain,$cnum)=split(/\//,$courseid); |
Line 2591 sub coursedescription {
|
Line 2613 sub coursedescription {
|
# trying and trying and trying to get the course description. |
# trying and trying and trying to get the course description. |
my %envhash=(); |
my %envhash=(); |
my %returnhash=(); |
my %returnhash=(); |
$envhash{'course.'.$normalid.'.last_cache'}=time; |
|
|
my $expiretime=600; |
|
if ($env{'request.course.id'} eq $normalid) { |
|
$expiretime=120; |
|
} |
|
|
|
my $prefix='course.'.$cdomain.'_'.$cnum.'.'; |
|
if (!$args->{'freshen_cache'} |
|
&& ((time-$env{$prefix.'last_cache'}) < $expiretime) ) { |
|
foreach my $key (keys(%env)) { |
|
next if ($key !~ /^\Q$prefix\E(.*)/); |
|
my ($setting) = $1; |
|
$returnhash{$setting} = $env{$key}; |
|
} |
|
return %returnhash; |
|
} |
|
|
|
# get the data agin |
|
if (!$args->{'one_time'}) { |
|
$envhash{'course.'.$normalid.'.last_cache'}=time; |
|
} |
if ($chome ne 'no_host') { |
if ($chome ne 'no_host') { |
%returnhash=&dump('environment',$cdomain,$cnum); |
%returnhash=&dump('environment',$cdomain,$cnum); |
if (!exists($returnhash{'con_lost'})) { |
if (!exists($returnhash{'con_lost'})) { |
Line 2609 sub coursedescription {
|
Line 2651 sub coursedescription {
|
$envhash{'course.'.$normalid.'.num'}=$cnum; |
$envhash{'course.'.$normalid.'.num'}=$cnum; |
} |
} |
} |
} |
&appenv(%envhash); |
if (!$args->{'one_time'}) { |
|
&appenv(%envhash); |
|
} |
return %returnhash; |
return %returnhash; |
} |
} |
|
|
Line 3429 sub allowed {
|
Line 3473 sub allowed {
|
my ($cdom,$cnum,$csec)=split(/\//,$courseid); |
my ($cdom,$cnum,$csec)=split(/\//,$courseid); |
my $prefix='course.'.$cdom.'_'.$cnum.'.'; |
my $prefix='course.'.$cdom.'_'.$cnum.'.'; |
if ((time-$env{$prefix.'last_cache'})>$expiretime) { |
if ((time-$env{$prefix.'last_cache'})>$expiretime) { |
&coursedescription($courseid); |
&coursedescription($courseid,{'freshen_cache' => 1}); |
} |
} |
if (($env{$prefix.'res.'.$uri.'.lock.sections'}=~/\,\Q$csec\E\,/) |
if (($env{$prefix.'res.'.$uri.'.lock.sections'}=~/\,\Q$csec\E\,/) |
|| ($env{$prefix.'res.'.$uri.'.lock.sections'} eq 'all')) { |
|| ($env{$prefix.'res.'.$uri.'.lock.sections'} eq 'all')) { |
Line 3941 sub modify_group_roles {
|
Line 3985 sub modify_group_roles {
|
if ($result eq 'ok') { |
if ($result eq 'ok') { |
&devalidate_getgroups_cache($udom,$uname,$cdom,$cnum); |
&devalidate_getgroups_cache($udom,$uname,$cdom,$cnum); |
} |
} |
|
|
return $result; |
return $result; |
} |
} |
|
|
Line 3975 sub get_group_membership {
|
Line 4018 sub get_group_membership {
|
|
|
sub get_users_groups { |
sub get_users_groups { |
my ($udom,$uname,$courseid) = @_; |
my ($udom,$uname,$courseid) = @_; |
|
my @usersgroups; |
my $cachetime=1800; |
my $cachetime=1800; |
$courseid=~s/\_/\//g; |
$courseid=~s/\_/\//g; |
$courseid=~s/^(\w)/\/$1/; |
$courseid=~s/^(\w)/\/$1/; |
|
|
my $hashid="$udom:$uname:$courseid"; |
my $hashid="$udom:$uname:$courseid"; |
my ($result,$cached)=&is_cached_new('getgroups',$hashid); |
my ($grouplist,$cached)=&is_cached_new('getgroups',$hashid); |
if (defined($cached)) { return $result; } |
if (defined($cached)) { |
|
@usersgroups = split(/:/,$grouplist); |
my %roleshash = &dump('roles',$udom,$uname,$courseid); |
} else { |
my ($tmp) = keys(%roleshash); |
$grouplist = ''; |
if ($tmp=~/^error:/) { |
my %roleshash = &dump('roles',$udom,$uname,$courseid); |
&logthis('Error retrieving roles: '.$tmp.' for '.$uname.':'.$udom); |
my ($tmp) = keys(%roleshash); |
return ''; |
if ($tmp=~/^error:/) { |
} else { |
&logthis('Error retrieving roles: '.$tmp.' for '.$uname.':'.$udom); |
my $grouplist; |
} else { |
foreach my $key (keys %roleshash) { |
my $access_end = $env{'course.'.$courseid. |
if ($key =~ /^\Q$courseid\E\/(\w+)\_gr$/) { |
'.default_enrollment_end_date'}; |
unless ($roleshash{$key} =~ /_1_1$/) { # deleted membership |
my $now = time; |
$grouplist .= $1.':'; |
foreach my $key (keys(%roleshash)) { |
|
if ($key =~ /^\Q$courseid\E\/(\w+)\_gr$/) { |
|
my $group = $1; |
|
if ($roleshash{$key} =~ /_(\d+)_(\d+)$/) { |
|
my $start = $2; |
|
my $end = $1; |
|
if ($start == -1) { next; } # deleted from group |
|
if (($start!=0) && ($start>$now)) { next; } |
|
if (($end!=0) && ($end<$now)) { |
|
if ($access_end && $access_end < $now) { |
|
if ($access_end - $end < 86400) { |
|
push(@usersgroups,$group); |
|
} |
|
} |
|
next; |
|
} |
|
push(@usersgroups,$group); |
|
} |
} |
} |
} |
} |
|
@usersgroups = &sort_course_groups($courseid,@usersgroups); |
|
$grouplist = join(':',@usersgroups); |
|
&do_cache_new('getgroups',$hashid,$grouplist,$cachetime); |
} |
} |
$grouplist =~ s/:$//; |
|
return &do_cache_new('getgroups',$hashid,$grouplist,$cachetime); |
|
} |
} |
|
return @usersgroups; |
} |
} |
|
|
sub devalidate_getgroups_cache { |
sub devalidate_getgroups_cache { |
Line 4064 sub assignrole {
|
Line 4127 sub assignrole {
|
$command.='_0_'.$start; |
$command.='_0_'.$start; |
} |
} |
} |
} |
|
my $origstart = $start; |
|
my $origend = $end; |
# actually delete |
# actually delete |
if ($deleteflag) { |
if ($deleteflag) { |
if ((&allowed('dro',$udom)) || (&allowed('dro',$url))) { |
if ((&allowed('dro',$udom)) || (&allowed('dro',$url))) { |
Line 4081 sub assignrole {
|
Line 4146 sub assignrole {
|
# log new user role if status is ok |
# log new user role if status is ok |
if ($answer eq 'ok') { |
if ($answer eq 'ok') { |
&userrolelog($role,$uname,$udom,$url,$start,$end); |
&userrolelog($role,$uname,$udom,$url,$start,$end); |
|
# for course roles, perform group memberships changes triggered by role change. |
|
unless ($role =~ /^gr/) { |
|
&Apache::longroup::group_changes($udom,$uname,$url,$role,$origend, |
|
$origstart); |
|
} |
} |
} |
return $answer; |
return $answer; |
} |
} |
Line 4757 sub stat_file {
|
Line 4827 sub stat_file {
|
($udom,$uname,$file) = |
($udom,$uname,$file) = |
($uri =~ m-/(?:uploaded|editupload)/?([^/]*)/?([^/]*)/?(.*)-); |
($uri =~ m-/(?:uploaded|editupload)/?([^/]*)/?([^/]*)/?(.*)-); |
$file = 'userfiles/'.$file; |
$file = 'userfiles/'.$file; |
$dir = &Apache::loncommon::propath($udom,$uname); |
$dir = &propath($udom,$uname); |
} |
} |
if ($uri =~ m-^/res/-) { |
if ($uri =~ m-^/res/-) { |
($udom,$uname) = |
($udom,$uname) = |
Line 5110 sub EXT {
|
Line 5180 sub EXT {
|
|
|
# ----------------------------------------------------- Cascading lookup scheme |
# ----------------------------------------------------- Cascading lookup scheme |
my $symbp=$symbparm; |
my $symbp=$symbparm; |
my $mapp=(&decode_symb($symbp))[0]; |
my $mapp=&deversion((&decode_symb($symbp))[0]); |
|
|
my $symbparm=$symbp.'.'.$spacequalifierrest; |
my $symbparm=$symbp.'.'.$spacequalifierrest; |
my $mapparm=$mapp.'___(all).'.$spacequalifierrest; |
my $mapparm=$mapp.'___(all).'.$spacequalifierrest; |
Line 5118 sub EXT {
|
Line 5188 sub EXT {
|
if (($env{'user.name'} eq $uname) && |
if (($env{'user.name'} eq $uname) && |
($env{'user.domain'} eq $udom)) { |
($env{'user.domain'} eq $udom)) { |
$section=$env{'request.course.sec'}; |
$section=$env{'request.course.sec'}; |
@groups=&sort_course_groups($env{'request.course.groups'},$courseid); |
@groups = split(/:/,$env{'request.course.groups'}); |
|
@groups=&sort_course_groups($courseid,@groups); |
} else { |
} else { |
if (! defined($usection)) { |
if (! defined($usection)) { |
$section=&getsection($udom,$uname,$courseid); |
$section=&getsection($udom,$uname,$courseid); |
} else { |
} else { |
$section = $usection; |
$section = $usection; |
} |
} |
my $grouplist = &get_users_groups($udom,$uname,$courseid); |
@groups = &get_users_groups($udom,$uname,$courseid); |
if ($grouplist) { |
|
@groups=&sort_course_groups($grouplist,$courseid); |
|
} |
|
} |
} |
|
|
my $seclevel=$courseid.'.['.$section.'].'.$spacequalifierrest; |
my $seclevel=$courseid.'.['.$section.'].'.$spacequalifierrest; |
Line 5252 sub check_group_parms {
|
Line 5320 sub check_group_parms {
|
} |
} |
|
|
sub sort_course_groups { # Sort groups based on defined rankings. Default is sort(). |
sub sort_course_groups { # Sort groups based on defined rankings. Default is sort(). |
my ($grouplist,$courseid) = @_; |
my ($courseid,@groups) = @_; |
my @groups = sort(split(/:/,$grouplist)); |
@groups = sort(@groups); |
return @groups; |
return @groups; |
} |
} |
|
|
sub packages_tab_default { |
sub packages_tab_default { |
my ($uri,$varname)=@_; |
my ($uri,$varname)=@_; |
my (undef,$part,$name)=split(/\./,$varname); |
my (undef,$part,$name)=split(/\./,$varname); |
my $packages=&metadata($uri,'packages'); |
|
foreach my $package (split(/,/,$packages)) { |
my (@extension,@specifics,$do_default); |
|
foreach my $package (split(/,/,&metadata($uri,'packages'))) { |
my ($pack_type,$pack_part)=split(/_/,$package,2); |
my ($pack_type,$pack_part)=split(/_/,$package,2); |
|
if ($pack_type eq 'default') { |
|
$do_default=1; |
|
} elsif ($pack_type eq 'extension') { |
|
push(@extension,[$package,$pack_type,$pack_part]); |
|
} else { |
|
push(@specifics,[$package,$pack_type,$pack_part]); |
|
} |
|
} |
|
# first look for a package that matches the requested part id |
|
foreach my $package (@specifics) { |
|
my (undef,$pack_type,$pack_part)=@{$package}; |
|
next if ($pack_part ne $part); |
|
if (defined($packagetab{"$pack_type&$name&default"})) { |
|
return $packagetab{"$pack_type&$name&default"}; |
|
} |
|
} |
|
# look for any possible matching non extension_ package |
|
foreach my $package (@specifics) { |
|
my (undef,$pack_type,$pack_part)=@{$package}; |
if (defined($packagetab{"$pack_type&$name&default"})) { |
if (defined($packagetab{"$pack_type&$name&default"})) { |
return $packagetab{"$pack_type&$name&default"}; |
return $packagetab{"$pack_type&$name&default"}; |
} |
} |
Line 5271 sub packages_tab_default {
|
Line 5359 sub packages_tab_default {
|
return $packagetab{$pack_type."_".$pack_part."&$name&default"}; |
return $packagetab{$pack_type."_".$pack_part."&$name&default"}; |
} |
} |
} |
} |
|
# look for any posible extension_ match |
|
foreach my $package (@extension) { |
|
my ($package,$pack_type)=@{$package}; |
|
if (defined($packagetab{"$pack_type&$name&default"})) { |
|
return $packagetab{"$pack_type&$name&default"}; |
|
} |
|
if (defined($packagetab{$package."&$name&default"})) { |
|
return $packagetab{$package."&$name&default"}; |
|
} |
|
} |
|
# look for a global default setting |
|
if ($do_default && defined($packagetab{"default&$name&default"})) { |
|
return $packagetab{"default&$name&default"}; |
|
} |
return undef; |
return undef; |
} |
} |
|
|
Line 5356 sub metadata {
|
Line 5458 sub metadata {
|
} else { |
} else { |
$metaentry{':packages'}=$package.$keyroot; |
$metaentry{':packages'}=$package.$keyroot; |
} |
} |
foreach (sort keys %packagetab) { |
foreach my $pack_entry (keys(%packagetab)) { |
my $part=$keyroot; |
my $part=$keyroot; |
$part=~s/^\_//; |
$part=~s/^\_//; |
if ($_=~/^\Q$package\E\&/ || |
if ($pack_entry=~/^\Q$package\E\&/ || |
$_=~/^\Q$package\E_0\&/) { |
$pack_entry=~/^\Q$package\E_0\&/) { |
my ($pack,$name,$subp)=split(/\&/,$_); |
my ($pack,$name,$subp)=split(/\&/,$pack_entry); |
# ignore package.tab specified default values |
# ignore package.tab specified default values |
# here &package_tab_default() will fetch those |
# here &package_tab_default() will fetch those |
if ($subp eq 'default') { next; } |
if ($subp eq 'default') { next; } |
my $value=$packagetab{$_}; |
my $value=$packagetab{$pack_entry}; |
my $unikey; |
my $unikey; |
if ($pack =~ /_0$/) { |
if ($pack =~ /_0$/) { |
$unikey='parameter_0_'.$name; |
$unikey='parameter_0_'.$name; |
Line 5413 sub metadata {
|
Line 5515 sub metadata {
|
my $dir=$filename; |
my $dir=$filename; |
$dir=~s|[^/]*$||; |
$dir=~s|[^/]*$||; |
$location=&filelocation($dir,$location); |
$location=&filelocation($dir,$location); |
foreach (sort(split(/\,/,&metadata($uri,'keys', |
my $metadata = |
$location,$unikey, |
&metadata($uri,'keys', $location,$unikey, |
$depthcount+1)))) { |
$depthcount+1); |
$metaentry{':'.$_}=$metaentry{':'.$_}; |
foreach my $meta (split(',',$metadata)) { |
$metathesekeys{$_}=1; |
$metaentry{':'.$meta}=$metaentry{':'.$meta}; |
|
$metathesekeys{$meta}=1; |
} |
} |
} |
} |
} else { |
} else { |
Line 5426 sub metadata {
|
Line 5529 sub metadata {
|
$unikey.='_'.$token->[2]->{'name'}; |
$unikey.='_'.$token->[2]->{'name'}; |
} |
} |
$metathesekeys{$unikey}=1; |
$metathesekeys{$unikey}=1; |
foreach (@{$token->[3]}) { |
foreach my $param (@{$token->[3]}) { |
$metaentry{':'.$unikey.'.'.$_}=$token->[2]->{$_}; |
$metaentry{':'.$unikey.'.'.$param} = |
|
$token->[2]->{$param}; |
} |
} |
my $internaltext=&HTML::Entities::decode($parser->get_text('/'.$entry)); |
my $internaltext=&HTML::Entities::decode($parser->get_text('/'.$entry)); |
my $default=$metaentry{':'.$unikey.'.default'}; |
my $default=$metaentry{':'.$unikey.'.default'}; |
Line 5448 sub metadata {
|
Line 5552 sub metadata {
|
} |
} |
} |
} |
my ($extension) = ($uri =~ /\.(\w+)$/); |
my ($extension) = ($uri =~ /\.(\w+)$/); |
foreach my $key (sort(keys(%packagetab))) { |
foreach my $key (keys(%packagetab)) { |
#no specific packages #how's our extension |
#no specific packages #how's our extension |
if ($key!~/^extension_\Q$extension\E&/) { next; } |
if ($key!~/^extension_\Q$extension\E&/) { next; } |
&metadata_create_package_def($uri,$key,'extension_'.$extension, |
&metadata_create_package_def($uri,$key,'extension_'.$extension, |
\%metathesekeys); |
\%metathesekeys); |
} |
} |
if (!exists($metaentry{':packages'})) { |
if (!exists($metaentry{':packages'})) { |
foreach my $key (sort(keys(%packagetab))) { |
foreach my $key (keys(%packagetab)) { |
#no specific packages well let's get default then |
#no specific packages well let's get default then |
if ($key!~/^default&/) { next; } |
if ($key!~/^default&/) { next; } |
&metadata_create_package_def($uri,$key,'default', |
&metadata_create_package_def($uri,$key,'default', |
Line 5473 sub metadata {
|
Line 5577 sub metadata {
|
my $dir=$filename; |
my $dir=$filename; |
$dir=~s|[^/]*$||; |
$dir=~s|[^/]*$||; |
$location=&filelocation($dir,$location); |
$location=&filelocation($dir,$location); |
foreach (sort(split(/\,/,&metadata($uri,'keys', |
my $rights_metadata = |
$location,'_rights', |
&metadata($uri,'keys',$location,'_rights', |
$depthcount+1)))) { |
$depthcount+1); |
#$metaentry{':'.$_}=$metacache{$uri}->{':'.$_}; |
foreach my $rights (split(',',$rights_metadata)) { |
$metathesekeys{$_}=1; |
#$metaentry{':'.$rights}=$metacache{$uri}->{':'.$rights}; |
|
$metathesekeys{$rights}=1; |
} |
} |
} |
} |
} |
} |
$metaentry{':keys'}=join(',',keys %metathesekeys); |
# uniqifiy package listing |
|
my %seen; |
|
my @uniq_packages = |
|
grep { ! $seen{$_} ++ } (split(',',$metaentry{':packages'})); |
|
$metaentry{':packages'} = join(',',@uniq_packages); |
|
|
|
$metaentry{':keys'} = join(',',keys(%metathesekeys)); |
&metadata_generate_part0(\%metathesekeys,\%metaentry,$uri); |
&metadata_generate_part0(\%metathesekeys,\%metaentry,$uri); |
$metaentry{':allpossiblekeys'}=join(',',keys %metathesekeys); |
$metaentry{':allpossiblekeys'}=join(',',keys %metathesekeys); |
&do_cache_new('meta',$uri,\%metaentry,60*60); |
&do_cache_new('meta',$uri,\%metaentry,60*60); |
Line 5517 sub metadata_create_package_def {
|
Line 5628 sub metadata_create_package_def {
|
sub metadata_generate_part0 { |
sub metadata_generate_part0 { |
my ($metadata,$metacache,$uri) = @_; |
my ($metadata,$metacache,$uri) = @_; |
my %allnames; |
my %allnames; |
foreach my $metakey (sort keys %$metadata) { |
foreach my $metakey (keys(%$metadata)) { |
if ($metakey=~/^parameter\_(.*)/) { |
if ($metakey=~/^parameter\_(.*)/) { |
my $part=$$metacache{':'.$metakey.'.part'}; |
my $part=$$metacache{':'.$metakey.'.part'}; |
my $name=$$metacache{':'.$metakey.'.name'}; |
my $name=$$metacache{':'.$metakey.'.name'}; |
Line 6352 sub filelocation {
|
Line 6463 sub filelocation {
|
my @ids=¤t_machine_ids(); |
my @ids=¤t_machine_ids(); |
foreach my $id (@ids) { if ($id eq $home) { $is_me=1; } } |
foreach my $id (@ids) { if ($id eq $home) { $is_me=1; } } |
if ($is_me) { |
if ($is_me) { |
$location=&Apache::loncommon::propath($udom,$uname). |
$location=&propath($udom,$uname). |
'/userfiles/'.$filename; |
'/userfiles/'.$filename; |
} else { |
} else { |
$location=$Apache::lonnet::perlvar{'lonDocRoot'}.'/userfiles/'. |
$location=$Apache::lonnet::perlvar{'lonDocRoot'}.'/userfiles/'. |
Line 6473 sub freeze_escape {
|
Line 6584 sub freeze_escape {
|
return &escape($value); |
return &escape($value); |
} |
} |
|
|
# -------------------------------------------------------- Escape Special Chars |
|
|
|
sub escape { |
|
my $str=shift; |
|
$str =~ s/(\W)/"%".unpack('H2',$1)/eg; |
|
return $str; |
|
} |
|
|
|
# ----------------------------------------------------- Un-Escape Special Chars |
|
|
|
sub unescape { |
|
my $str=shift; |
|
$str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; |
|
return $str; |
|
} |
|
|
|
sub thaw_unescape { |
sub thaw_unescape { |
my ($value)=@_; |
my ($value)=@_; |
Line 6525 sub goodbye {
|
Line 6621 sub goodbye {
|
&logthis(sprintf("%-20s is %s",'hits',$hits)); |
&logthis(sprintf("%-20s is %s",'hits',$hits)); |
&flushcourselogs(); |
&flushcourselogs(); |
&logthis("Shutting down"); |
&logthis("Shutting down"); |
return DONE; |
|
} |
} |
|
|
BEGIN { |
BEGIN { |