version 1.12, 2006/07/03 10:26:22
|
version 1.14, 2006/11/22 19:58:29
|
Line 38 use POSIX;
|
Line 38 use POSIX;
|
|
|
my $loncapa_max_wait_time = 13; |
my $loncapa_max_wait_time = 13; |
|
|
|
|
|
use vars qw($match_domain $match_not_domain |
|
$match_username $match_not_username |
|
$match_handle $match_not_handle); |
|
|
require Exporter; |
require Exporter; |
our @ISA = qw (Exporter); |
our @ISA = qw (Exporter); |
our @EXPORT = qw(&add_get_param &escape &unescape &tie_domain_hash &untie_domain_hash &tie_user_hash &untie_user_hash &propath); |
our @EXPORT = qw(&add_get_param &escape &unescape |
|
&tie_domain_hash &untie_domain_hash &tie_user_hash |
|
&untie_user_hash &propath); |
|
our @EXPORT_OK = qw($match_domain $match_not_domain |
|
$match_username $match_not_username |
|
$match_handle $match_not_handle); |
|
our %EXPORT_TAGS = ( 'match' =>[qw($match_domain $match_not_domain |
|
$match_username $match_not_username |
|
$match_handle $match_not_handle)],); |
my %perlvar; |
my %perlvar; |
|
|
|
|
Line 83 sub unescape {
|
Line 96 sub unescape {
|
return $str; |
return $str; |
} |
} |
|
|
|
$match_domain = $LONCAPA::domain_re = qr{[\w\-.]+}; |
|
$match_not_domain = $LONCAPA::not_domain_re = qr{[^\w\-.]+}; |
|
sub clean_domain { |
|
my ($domain) = @_; |
|
$domain =~ s/$match_not_domain//g; |
|
return $domain; |
|
} |
|
|
|
sub split_courseid { |
|
my ($courseid) = @_; |
|
my ($domain,$coursenum) = |
|
($courseid=~m{^/($match_domain)/($match_username)}); |
|
return ($domain,$coursenum); |
|
} |
|
|
|
$match_username = $LONCAPA::username_re = qr{[\w\-.]+}; |
|
$match_not_username = $LONCAPA::not_username_re = qr{[^\w\-.]+}; |
|
sub clean_username { |
|
my ($username) = @_; |
|
$username =~ s/$match_not_username//g; |
|
return $username; |
|
} |
|
|
|
$match_handle = $LONCAPA::handle_re = qr{[\w\-.]+}; |
|
$match_not_handle = $LONCAPA::not_handle_re = qr{[^\w\-.]+}; |
|
sub clean_handle { |
|
my ($handle) = @_; |
|
$handle =~ s/$match_not_handle//g; |
|
return $handle; |
|
} |
|
|
# -------------------------------------------- Return path to profile directory |
# -------------------------------------------- Return path to profile directory |
|
|
sub propath { |
sub propath { |
my ($udom,$uname)=@_; |
my ($udom,$uname)=@_; |
$udom=~s/\W//g; |
$udom = &clean_domain($udom); |
$uname=~s/\W//g; |
$uname= &clean_username($uname); |
my $subdir=$uname.'__'; |
my $subdir=$uname.'__'; |
$subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/; |
$subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/; |
my $proname="$perlvar{'lonUsersDir'}/$udom/$subdir/$uname"; |
my $proname="$perlvar{'lonUsersDir'}/$udom/$subdir/$uname"; |
Line 122 sub tie_domain_hash {
|
Line 166 sub tie_domain_hash {
|
|
|
# Filter out any whitespace in the domain name: |
# Filter out any whitespace in the domain name: |
|
|
$domain =~ s/\W//g; |
$domain = &clean_domain($domain); |
|
|
# We have enough to go on to tie the hash: |
# We have enough to go on to tie the hash: |
|
|
Line 297 sub _do_hash_untie {
|
Line 341 sub _do_hash_untie {
|
# Change access mode to non-blocking |
# Change access mode to non-blocking |
$how=$how|&GDBM_NOLOCK(); |
$how=$how|&GDBM_NOLOCK(); |
# Go ahead and tie the hash |
# Go ahead and tie the hash |
return &_do_hash_tie($file_prefix,$namespace,$how,$loghead,$what); |
my $result = |
|
&_do_hash_tie($file_prefix,$namespace,$how,$loghead,$what); |
|
if (!$result) { |
|
&clean_sym(); |
|
} |
|
return $result; |
} |
} |
|
|
sub flock_sym { |
sub flock_sym { |