--- loncom/LONCAPA.pm 2006/11/27 16:34:38 1.15 +++ loncom/LONCAPA.pm 2007/01/10 20:22:30 1.23 @@ -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.23 2007/01/10 20:22:30 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -41,6 +41,9 @@ 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_lonid $match_handle $match_not_handle); require Exporter; @@ -50,9 +53,15 @@ 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_lonid $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_lonid $match_handle $match_not_handle)],); my %perlvar; @@ -104,21 +113,41 @@ 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{\w[\w\-.]+}; $match_not_username = $LONCAPA::not_username_re = qr{[^\w\-.]+}; sub clean_username { my ($username) = @_; + $username =~ s/^\W+//; $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 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; +} + +$match_lonid = $LONCAPA::lonid_re = qr{[\w\-.]+}; + +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 +161,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";