Diff for /loncom/LONCAPA.pm between versions 1.13 and 1.14

version 1.13, 2006/08/11 20:07:18 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:
           

Removed from v.1.13  
changed lines
  Added in v.1.14


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