Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.521 and 1.525

version 1.521, 2004/07/06 18:02:33 version 1.525, 2004/08/05 16:59:29
Line 1131  sub ssi_body { Line 1131  sub ssi_body {
     my ($filelink,%form)=@_;      my ($filelink,%form)=@_;
     my $output=($filelink=~/^http\:/?&externalssi($filelink):      my $output=($filelink=~/^http\:/?&externalssi($filelink):
                                      &ssi($filelink,%form));                                       &ssi($filelink,%form));
     $output=~s/^.*?\<body[^\>]*\>//si;  
     $output=~s/(.*)\<\/body\s*\>.*?$/$1/si;  
     $output=~      $output=~
             s/\/\/ BEGIN LON\-CAPA Internal.+\/\/ END LON\-CAPA Internal\s//gs;              s/\/\/ BEGIN LON\-CAPA Internal.+\/\/ END LON\-CAPA Internal\s//gs;
       $output=~s/^.*?\<body[^\>]*\>//si;
       $output=~s/(.*)\<\/body\s*\>.*?$/$1/si;
     return $output;      return $output;
 }  }
   
Line 1282  sub userfileupload { Line 1282  sub userfileupload {
 # 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});
       if (($formname eq 'screenshot') && ($subdir eq 'helprequests')) { #files uploaded to help request form are handled differently
           my $now = time;
           my $filepath = 'tmp/helprequests/'.$now;
           my @parts=split(/\//,$filepath);
           my $fullpath = $perlvar{'lonDaemons'};
           for (my $i=0;$i<@parts;$i++) {
               $fullpath .= '/'.$parts[$i];
               if ((-e $fullpath)!=1) {
                   mkdir($fullpath,0777);
               }
           }
           open(my $fh,'>'.$fullpath.'/'.$fname);
           print $fh $ENV{'form.'.$formname};
           close($fh);
           return $fullpath.'/'.$fname; 
       }
 # Create the directory if not present  # Create the directory if not present
     my $docuname='';      my $docuname='';
     my $docudom='';      my $docudom='';
Line 2575  sub put { Line 2591  sub put {
    return &reply("put:$udomain:$uname:$namespace:$items",$uhome);     return &reply("put:$udomain:$uname:$namespace:$items",$uhome);
 }  }
   
   # ---------------------------------------------------------- putstore interface
                                                                                        
   sub putstore {
      my ($namespace,$storehash,$udomain,$uname)=@_;
      if (!$udomain) { $udomain=$ENV{'user.domain'}; }
      if (!$uname) { $uname=$ENV{'user.name'}; }
      my $uhome=&homeserver($uname,$udomain);
      my $items='';
      my %allitems = ();
      foreach (keys %$storehash) {
          if ($_ =~ m/^([^\:]+):([^\:]+):([^\:]+)$/) {
              my $key = $1.':keys:'.$2;
              $allitems{$key} .= $3.':';
          }
          $items.=$_.'='.&escape($$storehash{$_}).'&';
      }
      foreach (keys %allitems) {
          $allitems{$_} =~ s/\:$//;
          $items.= $_.'='.$allitems{$_}.'&';
      }
      $items=~s/\&$//;
      return &reply("put:$udomain:$uname:$namespace:$items",$uhome);
   }
   
 # ------------------------------------------------------ critical put interface  # ------------------------------------------------------ critical put interface
   
 sub cput {  sub cput {
Line 4928  sub getfile { Line 4968  sub getfile {
  }   }
     } else {      } else {
  $lwpresp = &getuploaded('GET',$file,$cdom,$cnum,\$info,\$rtncode);   $lwpresp = &getuploaded('GET',$file,$cdom,$cnum,\$info,\$rtncode);
  &logthis("return is $lwpresp");  
  if ($lwpresp ne 'ok') {   if ($lwpresp ne 'ok') {
     my $ua=new LWP::UserAgent;      my $ua=new LWP::UserAgent;
     my $request=new HTTP::Request('GET',&tokenwrapper($file));      my $request=new HTTP::Request('GET',&tokenwrapper($file));
Line 5903  put($namespace,$storehash,$udom,$uname) Line 5942  put($namespace,$storehash,$udom,$uname)
   
 =item *  =item *
   
   putstore($namespace,$storehash,$udomain,$uname) : stores hash in namesp
   keys used in storehash include version information (e.g., 1:$symb:message etc.) as
   used in records written by &store and retrieved by &restore.  This function 
   was created for use in editing discussion posts, without incrementing the
   version number included in the key for a particular post. The colon 
   separated list of attribute names (e.g., the value associated with the key 
   1:keys:$symb) is also generated and passed in the ampersand separated 
   items sent to lonnet::reply().  
   
   =item *
   
 cput($namespace,$storehash,$udom,$uname) : critical put  cput($namespace,$storehash,$udom,$uname) : critical put
 ($udom and $uname are optional)  ($udom and $uname are optional)
   

Removed from v.1.521  
changed lines
  Added in v.1.525


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