[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.316 and 1.322

version 1.316, 2003/01/10 20:55:44 version 1.322, 2003/01/31 22:39:10
Line 864  sub userfileupload { Line 864  sub userfileupload {
 # Replace spaces by underscores  # Replace spaces by underscores
     $fname=~s/\s+/\_/g;      $fname=~s/\s+/\_/g;
 # Replace all other weird characters by nothing  # Replace all other weird characters by nothing
     $fname=~s/[^\w\.\-\+]//g;      $fname=~s/[^\w\.\-]//g;
 # See if there is anything left  # 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});
Line 1744  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 2766  sub EXT { Line 2817  sub EXT {
     } else {      } else {
  $courseid=$ENV{'request.course.id'};   $courseid=$ENV{'request.course.id'};
     }      }
   
     my ($realm,$space,$qualifier,@therest)=split(/\./,$varname);      my ($realm,$space,$qualifier,@therest)=split(/\./,$varname);
     my $rest;      my $rest;
     if ($therest[0]) {      if (defined($therest[0])) {
        $rest=join('.',@therest);         $rest=join('.',@therest);
     } else {      } else {
        $rest='';         $rest='';
     }      }
   
     my $qualifierrest=$qualifier;      my $qualifierrest=$qualifier;
     if ($rest) { $qualifierrest.='.'.$rest; }      if ($rest) { $qualifierrest.='.'.$rest; }
     my $spacequalifierrest=$space;      my $spacequalifierrest=$space;
Line 3034  sub metadata { Line 3085  sub metadata {
                       my $unikey='parameter'.$keyroot.'_'.$name;                        my $unikey='parameter'.$keyroot.'_'.$name;
                       $metathesekeys{$unikey}=1;                        $metathesekeys{$unikey}=1;
                       $metacache{$uri.':'.$unikey.'.part'}=$part;                        $metacache{$uri.':'.$unikey.'.part'}=$part;
                       unless                         unless (defined($metacache{$uri.':'.$unikey.'.'.$subp})) {
                        (defined($metacache{$uri.':'.$unikey.'.'.$subp})) {    $metacache{$uri.':'.$unikey.'.'.$subp}=$value;
                          $metacache{$uri.':'.$unikey.'.'.$subp}=$value;        }
         if (defined($metacache{$uri.':'.$unikey.'.default'})) {
     $metacache{$uri.':'.$unikey}=
        $metacache{$uri.':'.$unikey.'.default'}
       }        }
                   }                    }
               }                }
Line 3086  sub metadata { Line 3140  sub metadata {
               foreach (@{$token->[3]}) {                foreach (@{$token->[3]}) {
   $metacache{$uri.':'.$unikey.'.'.$_}=$token->[2]->{$_};    $metacache{$uri.':'.$unikey.'.'.$_}=$token->[2]->{$_};
               }                }
               unless (        my $internaltext=&HTML::Entities::decode($parser->get_text('/'.$entry));
                  $metacache{$uri.':'.$unikey}=&HTML::Entities::decode($parser->get_text('/'.$entry))        my $default=$metacache{$uri.':'.$unikey.'.default'};
       ) { $metacache{$uri.':'.$unikey}=        if ( $internaltext =~ /^\s*$/ && $default !~ /^\s*$/) {
       $metacache{$uri.':'.$unikey.'.default'};    # only ws inside the tag, and not in default, so use default
       }                    # as value
     $metacache{$uri.':'.$unikey}=$default;
         } else {
     # either something interesting inside the tag or default
                     # uninteresting
     $metacache{$uri.':'.$unikey}=$internaltext;
         }
 # end of not-a-package not-a-library import  # end of not-a-package not-a-library import
    }     }
 # end of not-a-package start tag  # end of not-a-package start tag
Removed from v.1.316  
changed lines
  Added in v.1.322

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