[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.715 and 1.721

version 1.715, 2006/03/04 01:00:15 version 1.721, 2006/03/26 21:20:55
Line 260  sub critical { Line 260  sub critical {
   
 sub transfer_profile_to_env {  sub transfer_profile_to_env {
     my ($lonidsdir,$handle)=@_;      my ($lonidsdir,$handle)=@_;
       if (!defined($lonidsdir)) {
    $lonidsdir = $perlvar{'lonIDsDir'};
       }
       if (!defined($handle)) {
           ($handle) = ($env{'user.environment'} =~m|/([^/]+)\.id$| );
       }
   
     my @profile;      my @profile;
     {      {
  open(my $idf,"$lonidsdir/$handle.id");   open(my $idf,"$lonidsdir/$handle.id");
Line 1320  sub clean_filename { Line 1327  sub clean_filename {
   
 # --------------- Take an uploaded file and put it into the userfiles directory  # --------------- Take an uploaded file and put it into the userfiles directory
 # input: $formname - the contents of the file are in $env{"form.$formname"}  # input: $formname - the contents of the file are in $env{"form.$formname"}
 #                    the desired filenam is in $env{"form.$formname"}  #                    the desired filenam is in $env{"form.$formname.filename"}
 #        $coursedoc - if true up to the current course  #        $coursedoc - if true up to the current course
 #                     if false  #                     if false
 #        $subdir - directory in userfile to store the file into  #        $subdir - directory in userfile to store the file into
Line 1331  sub clean_filename { Line 1338  sub clean_filename {
   
   
 sub userfileupload {  sub userfileupload {
     my ($formname,$coursedoc,$subdir,$parser,$allfiles,$codebase)=@_;      my ($formname,$coursedoc,$subdir,$parser,$allfiles,$codebase,$destuname,$destudom)=@_;
     if (!defined($subdir)) { $subdir='unknown'; }      if (!defined($subdir)) { $subdir='unknown'; }
     my $fname=$env{'form.'.$formname.'.filename'};      my $fname=$env{'form.'.$formname.'.filename'};
     $fname=&clean_filename($fname);      $fname=&clean_filename($fname);
Line 1354  sub userfileupload { Line 1361  sub userfileupload {
         close($fh);          close($fh);
         return $fullpath.'/'.$fname;           return $fullpath.'/'.$fname; 
     }      }
       
 # Create the directory if not present  # Create the directory if not present
     $fname="$subdir/$fname";      $fname="$subdir/$fname";
     if ($coursedoc) {      if ($coursedoc) {
Line 1369  sub userfileupload { Line 1377  sub userfileupload {
        $fname,$formname,$parser,         $fname,$formname,$parser,
        $allfiles,$codebase);         $allfiles,$codebase);
         }          }
       } elsif (defined($destuname)) {
           my $docuname=$destuname;
           my $docudom=$destudom;
    return &finishuserfileupload($docuname,$docudom,$formname,
        $fname,$parser,$allfiles,$codebase);
           
     } else {      } else {
         my $docuname=$env{'user.name'};          my $docuname=$env{'user.name'};
         my $docudom=$env{'user.domain'};          my $docudom=$env{'user.domain'};
Line 2855  sub dump { Line 2869  sub dump {
    return %returnhash;     return %returnhash;
 }  }
   
   # --------------------------------------------------------- dumpstore interface
   
   sub dumpstore {
      my ($namespace,$udomain,$uname,$regexp,$range)=@_;
      return &dump($namespace,$udomain,$uname,$regexp,$range);
   }
   
 # -------------------------------------------------------------- keys interface  # -------------------------------------------------------------- keys interface
   
 sub getkeys {  sub getkeys {
Line 3005  sub putstore { Line 3026  sub putstore {
        $items.= &escape($key).'='.&freeze_escape($storehash->{$key}).'&';         $items.= &escape($key).'='.&freeze_escape($storehash->{$key}).'&';
    }     }
    $items=~s/\&$//;     $items=~s/\&$//;
    $symb=&escape($symb);     my $esc_symb=&escape($symb);
    $version=&escape($version);     my $esc_v=&escape($version);
    my $reply =     my $reply =
        &reply("putstore:$udomain:$uname:$namespace:$symb:$version:$items",         &reply("putstore:$udomain:$uname:$namespace:$esc_symb:$esc_v:$items",
       $uhome);        $uhome);
    if ($reply eq 'unknown_cmd') {     if ($reply eq 'unknown_cmd') {
          # gfall back to way things use to be done
        return &old_putstore($namespace,$symb,$version,$storehash,$udomain,         return &old_putstore($namespace,$symb,$version,$storehash,$udomain,
     $uname);      $uname);
    }     }
Line 3018  sub putstore { Line 3040  sub putstore {
 }  }
   
 sub old_putstore {  sub old_putstore {
           my ($namespace,$symb,$version,$storehash,$udomain,$uname)=@_;
       if (!$udomain) { $udomain=$env{'user.domain'}; }
       if (!$uname) { $uname=$env{'user.name'}; }
       my $uhome=&homeserver($uname,$udomain);
       my %newstorehash;
       foreach (keys %$storehash) {
    my $key = $version.':'.&escape($symb).':'.$_;
    $newstorehash{$key} = $storehash->{$_};
       }
       my $items='';
       my %allitems = ();
       foreach (keys %newstorehash) {
    if ($_ =~ m/^([^\:]+):([^\:]+):([^\:]+)$/) {
       my $key = $1.':keys:'.$2;
       $allitems{$key} .= $3.':';
    }
    $items.=$_.'='.&freeze_escape($newstorehash{$_}).'&';
       }
       foreach (keys %allitems) {
    $allitems{$_} =~ s/\:$//;
    $items.= $_.'='.$allitems{$_}.'&';
       }
       $items=~s/\&$//;
       return &reply("put:$udomain:$uname:$namespace:$items",$uhome);
 }  }
   
 # ------------------------------------------------------ critical put interface  # ------------------------------------------------------ critical put interface
Line 4694  sub GetFileTimestamp { Line 4739  sub GetFileTimestamp {
   
 sub stat_file {  sub stat_file {
     my ($uri) = @_;      my ($uri) = @_;
     $uri = &clutter($uri);      $uri = '/'.&declutter($uri);
     my ($udom,$uname,$file,$dir);      my ($udom,$uname,$file,$dir);
     if ($uri =~ m-^/(uploaded|editupload)/-) {      if ($uri =~ m-^/(uploaded|editupload)/-) {
  ($udom,$uname,$file) =   ($udom,$uname,$file) =
Line 4715  sub stat_file { Line 4760  sub stat_file {
   
     my ($result) = &dirlist($file,$udom,$uname,$dir);      my ($result) = &dirlist($file,$udom,$uname,$dir);
     my @stats = split('&', $result);      my @stats = split('&', $result);
       
     if($stats[0] ne 'empty' && $stats[0] ne 'no_such_dir') {      if($stats[0] ne 'empty' && $stats[0] ne 'no_such_dir') {
  shift(@stats); #filename is first   shift(@stats); #filename is first
  return @stats;   return @stats;
Line 5198  sub check_group_parms { Line 5244  sub check_group_parms {
   
 sub sort_course_groups { # Sort groups based on defined rankings. Default is sort().  sub sort_course_groups { # Sort groups based on defined rankings. Default is sort().
     my ($grouplist,$courseid) = @_;      my ($grouplist,$courseid) = @_;
     my @groups = split/:/,$grouplist;      my @groups = sort(split(/:/,$grouplist));
     if (@groups > 1) {  
         @groups = sort(@groups);  
     }  
     return @groups;      return @groups;
 }  }
   
Line 6405  sub clutter { Line 6448  sub clutter {
      && $thisfn!~/\.(sequence|page)$/) {       && $thisfn!~/\.(sequence|page)$/) {
  $thisfn='/adm/coursedocs/showdoc'.$thisfn;   $thisfn='/adm/coursedocs/showdoc'.$thisfn;
     } else {      } else {
  &logthis("Got a blank emb style");  # &logthis("Got a blank emb style");
     }      }
  }   }
     }      }
Line 7226  all args are optional Line 7269  all args are optional
   
 =item *  =item *
   
   dumpstore($namespace,$udom,$uname,$regexp,$range) : 
   dumps the complete (or key matching regexp) namespace into a hash
   ($udom, $uname, $regexp, $range are optional) for a namespace that is
   normally &store()ed into
   
   $range should be either an integer '100' (give me the first 100
                                              matching records)
                 or be  two integers sperated by a - with no spaces
                    '30-50' (give me the 30th through the 50th matching
                             records)
   
   
   =item *
   
   putstore($namespace,$symb,$version,$storehash,$udomain,$uname) :
   replaces a &store() version of data with a replacement set of data
   for a particular resource in a namespace passed in the $storehash hash 
   reference
   
   =item *
   
 tmpstore($storehash,$symb,$namespace,$udom,$uname) : storage that  tmpstore($storehash,$symb,$namespace,$udom,$uname) : storage that
 works very similar to store/cstore, but all data is stored in a  works very similar to store/cstore, but all data is stored in a
 temporary location and can be reset using tmpreset, $storehash should  temporary location and can be reset using tmpreset, $storehash should
Line 7279  put($namespace,$storehash,$udom,$uname) Line 7343  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.715  
changed lines
  Added in v.1.721

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