[BACK]Return to lonnet.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / lonnet / perl

Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.311 and 1.319

version 1.311, 2002/12/06 16:34:55 version 1.319, 2003/01/15 19:34:03
Line 729  sub currentversion { Line 729  sub currentversion {
   
 sub subscribe {  sub subscribe {
     my $fname=shift;      my $fname=shift;
       if ($fname=~/\/(aboutme|syllabus|bulletinboard|smppg)$/) { return ''; }
     my $author=$fname;      my $author=$fname;
     $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;      $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;
     my ($udom,$uname)=split(/\//,$author);      my ($udom,$uname)=split(/\//,$author);
Line 856  sub tokenwrapper { Line 857  sub tokenwrapper {
 sub userfileupload {  sub userfileupload {
     my ($formname,$coursedoc)=@_;      my ($formname,$coursedoc)=@_;
     my $fname=$ENV{'form.'.$formname.'.filename'};      my $fname=$ENV{'form.'.$formname.'.filename'};
   # Replace Windows backslashes by forward slashes
     $fname=~s/\\/\//g;      $fname=~s/\\/\//g;
   # Get rid of everything but the actual filename
     $fname=~s/^.*\/([^\/]+)$/$1/;      $fname=~s/^.*\/([^\/]+)$/$1/;
   # Replace spaces by underscores
       $fname=~s/\s+/\_/g;
   # Replace all other weird characters by nothing
       $fname=~s/[^\w\.\-]//g;
   # See if there is anything left
     unless ($fname) { return 'error: no uploaded file'; }      unless ($fname) { return 'error: no uploaded file'; }
     chop($ENV{'form.'.$formname});      chop($ENV{'form.'.$formname});
 # Create the directory if not present  # Create the directory if not present
Line 1736  sub dump { Line 1744  sub dump {
    return %returnhash;     return %returnhash;
 }  }
   
   # --------------------------------------------------------------- currentdump
   sub currentdump {
      my ($namespace,$udomain,$uname)=@_;
      if (!$udomain) { $udomain = $ENV{'user.domain'}; }
      if (!$uname)   { $uname   = $ENV{'user.name'};   }
      my $uhome = &homeserver($uname,$udomain);
      my $rep=reply("currentdump:$udomain:$uname:$namespace",$uhome);
      return if ($rep =~ /^(error:|no_such_host)/);
      #
      my %returnhash=();
      #
      if ($rep eq "unknown_cmd") { 
          # an old lond will not know currentdump
          # Do a dump and make it look like a currentdump
          my @tmp = &dump($namespace,$udomain,$uname,'.');
          return if ($tmp[0] =~ /^(error:|no_such_host)/);
          my %hash = @tmp;
          @tmp=();
          # Code ripped from lond, essentially.  The only difference
          # here is the unescaping done by lonnet::dump().  Conceivably
          # we might run in to problems with parameter names =~ /^v\./
          while (my ($key,$value) = each(%hash)) {
              my ($v,$symb,$param) = split(/:/,$key);
              next if ($v eq 'version' || $symb eq 'keys');
              next if (exists($returnhash{$symb}) &&
                       exists($returnhash{$symb}->{$param}) &&
                       $returnhash{$symb}->{'v.'.$param} > $v);
              $returnhash{$symb}->{$param}=$value;
              $returnhash{$symb}->{'v.'.$param}=$v;
          }
          #
          # Remove all of the keys in the hashes which keep track of
          # the version of the parameter.
          while (my ($symb,$param_hash) = each(%returnhash)) {
              # use a foreach because we are going to delete from the hash.
              foreach my $key (keys(%$param_hash)) {
                  delete($param_hash->{$key}) if ($key =~ /^v\./);
              }
          }
      } else {
          my @pairs=split(/\&/,$rep);
          foreach (@pairs) {
              my ($key,$value)=split(/=/,$_);
              my ($symb,$param) = split(/:/,$key);
              $returnhash{&unescape($symb)}->{&unescape($param)} = 
                                                             &unescape($value);
          }
      }
      return %returnhash;
   }
   
 # --------------------------------------------------------------- put interface  # --------------------------------------------------------------- put interface
   
 sub put {  sub put {
Line 1863  sub allowed { Line 1922  sub allowed {
        $thisallowed.=$1;         $thisallowed.=$1;
     }      }
   
   # URI is an uploaded document for this course
   
       if (($priv eq 'bre') && 
           ($uri=~/^uploaded\/$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}\/$ENV{'course.'.$ENV{'request.course.id'}.'.num'}/)) {
           return 'F';
       }
 # Full access at system, domain or course-wide level? Exit.  # Full access at system, domain or course-wide level? Exit.
   
     if ($thisallowed=~/F/) {      if ($thisallowed=~/F/) {
Line 2349  sub modifyuser { Line 2414  sub modifyuser {
        }         }
     }      }
 # -------------------------------------------------------------- Add names, etc  # -------------------------------------------------------------- Add names, etc
     my %names=&get('environment',      my @tmp=&get('environment',
    ['firstname','middlename','lastname','generation'],     ['firstname','middlename','lastname','generation'],
    $udom,$uname);     $udom,$uname);
     if ($names{'firstname'} =~ m/^error:.*/) { %names=(); }      my %names;
       if ($tmp[0] =~ m/^error:.*/) { 
           %names=(); 
       } else {
           %names = @tmp;
       }
     if ($first)  { $names{'firstname'}  = $first; }      if ($first)  { $names{'firstname'}  = $first; }
     if ($middle) { $names{'middlename'} = $middle; }      if ($middle) { $names{'middlename'} = $middle; }
     if ($last)   { $names{'lastname'}   = $last; }      if ($last)   { $names{'lastname'}   = $last; }
Removed from v.1.311  
changed lines
  Added in v.1.319

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