Diff for /loncom/LONCAPA.pm between versions 1.15 and 1.16

version 1.15, 2006/11/27 16:34:38 version 1.16, 2006/12/01 21:52:28
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{[^a-zA-Z\_][\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/^\d+//;
     $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 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_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 154  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";

Removed from v.1.15  
changed lines
  Added in v.1.16


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>