version 1.15, 2006/11/27 16:34:38
|
version 1.22, 2006/12/20 22:23:50
|
Line 41 my $loncapa_max_wait_time = 13;
|
Line 41 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_name |
$match_handle $match_not_handle); |
$match_handle $match_not_handle); |
|
|
require Exporter; |
require Exporter; |
Line 50 our @EXPORT = qw(&add_get_param &esca
|
Line 52 our @EXPORT = qw(&add_get_param &esca
|
&untie_user_hash &propath); |
&untie_user_hash &propath); |
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_name |
$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_name |
$match_handle $match_not_handle)],); |
$match_handle $match_not_handle)],); |
my %perlvar; |
my %perlvar; |
|
|
Line 104 sub clean_domain {
|
Line 110 sub clean_domain {
|
return $domain; |
return $domain; |
} |
} |
|
|
sub split_courseid { |
$match_username = $LONCAPA::username_re = qr{\w[\w\-.]+}; |
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\-.]+}; |
$match_not_username = $LONCAPA::not_username_re = qr{[^\w\-.]+}; |
sub clean_username { |
sub clean_username { |
my ($username) = @_; |
my ($username) = @_; |
|
$username =~ s/^\W+//; |
$username =~ s/$match_not_username//g; |
$username =~ s/$match_not_username//g; |
return $username; |
return $username; |
} |
} |
|
|
|
|
|
$match_courseid = $LONCAPA::courseid_re = qr{\d[\w\-.]+}; |
|
$match_not_courseid = $LONCAPA::not_courseid_re = qr{[^\w\-.]+}; |
|
sub clean_courseid { |
|
my ($courseid) = @_; |
|
$courseid =~ s/^\D+//; |
|
$courseid =~ s/$match_not_courseid//g; |
|
return $courseid; |
|
} |
|
|
|
$match_name = $LONCAPA::name_re = qr{$match_username|$match_courseid}; |
|
sub clean_name { |
|
my ($name) = @_; |
|
$name =~ s/$match_not_username//g; |
|
return $name; |
|
} |
|
|
|
sub split_courseid { |
|
my ($courseid) = @_; |
|
my ($domain,$coursenum) = |
|
($courseid=~m{^/($match_domain)/($match_courseid)}); |
|
return ($domain,$coursenum); |
|
} |
|
|
$match_handle = $LONCAPA::handle_re = qr{[\w\-.]+}; |
$match_handle = $LONCAPA::handle_re = qr{[\w\-.]+}; |
$match_not_handle = $LONCAPA::not_handle_re = qr{[^\w\-.]+}; |
$match_not_handle = $LONCAPA::not_handle_re = qr{[^\w\-.]+}; |
sub clean_handle { |
sub clean_handle { |
Line 132 sub clean_handle {
|
Line 156 sub clean_handle {
|
sub propath { |
sub propath { |
my ($udom,$uname)=@_; |
my ($udom,$uname)=@_; |
$udom = &clean_domain($udom); |
$udom = &clean_domain($udom); |
$uname= &clean_username($uname); |
$uname= &clean_name($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"; |