--- loncom/LONCAPA.pm 2006/11/27 16:34:38 1.15 +++ loncom/LONCAPA.pm 2006/12/01 21:52:28 1.16 @@ -1,7 +1,7 @@ # The LearningOnline Network # Base routines # -# $Id: LONCAPA.pm,v 1.15 2006/11/27 16:34:38 albertel Exp $ +# $Id: LONCAPA.pm,v 1.16 2006/12/01 21:52:28 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -41,6 +41,8 @@ my $loncapa_max_wait_time = 13; use vars qw($match_domain $match_not_domain $match_username $match_not_username + $match_courseid $match_not_courseid + $match_name $match_handle $match_not_handle); require Exporter; @@ -50,9 +52,13 @@ our @EXPORT = qw(&add_get_param &esca &untie_user_hash &propath); our @EXPORT_OK = qw($match_domain $match_not_domain $match_username $match_not_username + $match_courseid $match_not_courseid + $match_name $match_handle $match_not_handle); our %EXPORT_TAGS = ( 'match' =>[qw($match_domain $match_not_domain $match_username $match_not_username + $match_courseid $match_not_courseid + $match_name $match_handle $match_not_handle)],); my %perlvar; @@ -104,21 +110,37 @@ sub clean_domain { 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_username = $LONCAPA::username_re = qr{[^a-zA-Z\_][\w\-.]+}; $match_not_username = $LONCAPA::not_username_re = qr{[^\w\-.]+}; sub clean_username { my ($username) = @_; + $username =~ s/^\d+//; $username =~ s/$match_not_username//g; return $username; } + +$match_courseid = $LONCAPA::courseid_re = qr{\d[\w\-.]+}; +$match_not_courseid = $LONCAPA::not_courseid_re = qr{[^\w\-.]+}; +sub is_courseid { + my ($courseid) = @_; + return ($courseid =~ m/^$match_courseid$/); +} + +$match_name = 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_not_handle = $LONCAPA::not_handle_re = qr{[^\w\-.]+}; sub clean_handle { @@ -132,7 +154,7 @@ sub clean_handle { sub propath { my ($udom,$uname)=@_; $udom = &clean_domain($udom); - $uname= &clean_username($uname); + $uname= &clean_name($uname); my $subdir=$uname.'__'; $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/; my $proname="$perlvar{'lonUsersDir'}/$udom/$subdir/$uname";