version 1.28, 2009/05/13 14:01:10
|
version 1.31, 2011/05/14 16:12:53
|
Line 44 my $loncapa_max_wait_time = 13;
|
Line 44 my $loncapa_max_wait_time = 13;
|
use vars qw($match_domain $match_not_domain |
use vars qw($match_domain $match_not_domain |
$match_username $match_not_username |
$match_username $match_not_username |
$match_courseid $match_not_courseid |
$match_courseid $match_not_courseid |
|
$match_community |
$match_name |
$match_name |
$match_lonid |
$match_lonid |
$match_handle $match_not_handle); |
$match_handle $match_not_handle); |
Line 56 our @EXPORT = qw(&add_get_param &esca
|
Line 57 our @EXPORT = qw(&add_get_param &esca
|
our @EXPORT_OK = qw($match_domain $match_not_domain |
our @EXPORT_OK = qw($match_domain $match_not_domain |
$match_username $match_not_username |
$match_username $match_not_username |
$match_courseid $match_not_courseid |
$match_courseid $match_not_courseid |
|
$match_community |
$match_name |
$match_name |
$match_lonid |
$match_lonid |
$match_handle $match_not_handle); |
$match_handle $match_not_handle); |
our %EXPORT_TAGS = ( 'match' =>[qw($match_domain $match_not_domain |
our %EXPORT_TAGS = ( 'match' =>[qw($match_domain $match_not_domain |
$match_username $match_not_username |
$match_username $match_not_username |
$match_courseid $match_not_courseid |
$match_courseid $match_not_courseid |
|
$match_community |
$match_name |
$match_name |
$match_lonid |
$match_lonid |
$match_handle $match_not_handle)],); |
$match_handle $match_not_handle)],); |
Line 100 sub unescape {
|
Line 103 sub unescape {
|
return $str; |
return $str; |
} |
} |
|
|
$match_domain = $LONCAPA::domain_re = qr{[\w\-.]+}; |
$match_domain = $LONCAPA::domain_re = qr{[[:alnum:]\-.]+}; |
$match_not_domain = $LONCAPA::not_domain_re = qr{[^\w\-.]+}; |
$match_not_domain = $LONCAPA::not_domain_re = qr{[^[:alnum:]\-.]+}; |
sub clean_domain { |
sub clean_domain { |
my ($domain) = @_; |
my ($domain) = @_; |
$domain =~ s/$match_not_domain//g; |
$domain =~ s/$match_not_domain//g; |
Line 119 sub clean_username {
|
Line 122 sub clean_username {
|
|
|
|
|
$match_courseid = $LONCAPA::courseid_re = qr{\d[\w\-.]+}; |
$match_courseid = $LONCAPA::courseid_re = qr{\d[\w\-.]+}; |
|
$match_community =$LONCAPA::community_re = qr{0[\w\-.]+}; |
$match_not_courseid = $LONCAPA::not_courseid_re = qr{[^\w\-.]+}; |
$match_not_courseid = $LONCAPA::not_courseid_re = qr{[^\w\-.]+}; |
sub clean_courseid { |
sub clean_courseid { |
my ($courseid) = @_; |
my ($courseid) = @_; |
Line 151 sub clean_handle {
|
Line 155 sub clean_handle {
|
return $handle; |
return $handle; |
} |
} |
|
|
|
# |
|
# -- Ensure another process for same filesystem action is not running. |
|
# lond uses for: apachereload; loncron uses for: lciptables |
|
# |
|
|
|
sub try_to_lock { |
|
my ($lockfile)=@_; |
|
my $currentpid; |
|
my $lastpid; |
|
# Do not manipulate lock file as root |
|
if ($>==0) { |
|
return 0; |
|
} |
|
# Try to generate lock file. |
|
# Wait 3 seconds. If same process id is in |
|
# lock file, then assume lock file is stale, and |
|
# go ahead. If process id's fluctuate, try |
|
# for a maximum of 10 times. |
|
for (0..10) { |
|
if (-e $lockfile) { |
|
open(LOCK,"<$lockfile"); |
|
$currentpid=<LOCK>; |
|
close LOCK; |
|
if ($currentpid==$lastpid) { |
|
last; |
|
} |
|
sleep 3; |
|
$lastpid=$currentpid; |
|
} else { |
|
last; |
|
} |
|
if ($_==10) { |
|
return 0; |
|
} |
|
} |
|
open(LOCK,">$lockfile"); |
|
print LOCK $$; |
|
close LOCK; |
|
return 1; |
|
} |
|
|
# -------------------------------------------- Return path to profile directory |
# -------------------------------------------- Return path to profile directory |
|
|
sub propath { |
sub propath { |
Line 161 sub propath {
|
Line 206 sub propath {
|
$subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/; |
$subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/; |
my $proname="$perlvar{'lonUsersDir'}/$udom/$subdir/$uname"; |
my $proname="$perlvar{'lonUsersDir'}/$udom/$subdir/$uname"; |
return $proname; |
return $proname; |
} |
} |
|
|
|
|
sub tie_domain_hash { |
sub tie_domain_hash { |
my ($domain,$namespace,$how,$loghead,$logtail) = @_; |
my ($domain,$namespace,$how,$loghead,$logtail) = @_; |