--- loncom/lonnet/perl/lonnet.pm 2006/03/04 04:25:31 1.716 +++ loncom/lonnet/perl/lonnet.pm 2006/03/26 21:20:55 1.721 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.716 2006/03/04 04:25:31 albertel Exp $ +# $Id: lonnet.pm,v 1.721 2006/03/26 21:20:55 banghart Exp $ # # Copyright Michigan State University Board of Trustees # @@ -260,6 +260,13 @@ sub critical { sub transfer_profile_to_env { my ($lonidsdir,$handle)=@_; + if (!defined($lonidsdir)) { + $lonidsdir = $perlvar{'lonIDsDir'}; + } + if (!defined($handle)) { + ($handle) = ($env{'user.environment'} =~m|/([^/]+)\.id$| ); + } + my @profile; { open(my $idf,"$lonidsdir/$handle.id"); @@ -1320,7 +1327,7 @@ sub clean_filename { # --------------- Take an uploaded file and put it into the userfiles directory # 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 # if false # $subdir - directory in userfile to store the file into @@ -1331,7 +1338,7 @@ sub clean_filename { sub userfileupload { - my ($formname,$coursedoc,$subdir,$parser,$allfiles,$codebase)=@_; + my ($formname,$coursedoc,$subdir,$parser,$allfiles,$codebase,$destuname,$destudom)=@_; if (!defined($subdir)) { $subdir='unknown'; } my $fname=$env{'form.'.$formname.'.filename'}; $fname=&clean_filename($fname); @@ -1354,6 +1361,7 @@ sub userfileupload { close($fh); return $fullpath.'/'.$fname; } + # Create the directory if not present $fname="$subdir/$fname"; if ($coursedoc) { @@ -1369,6 +1377,12 @@ sub userfileupload { $fname,$formname,$parser, $allfiles,$codebase); } + } elsif (defined($destuname)) { + my $docuname=$destuname; + my $docudom=$destudom; + return &finishuserfileupload($docuname,$docudom,$formname, + $fname,$parser,$allfiles,$codebase); + } else { my $docuname=$env{'user.name'}; my $docudom=$env{'user.domain'}; @@ -2855,6 +2869,13 @@ sub dump { return %returnhash; } +# --------------------------------------------------------- dumpstore interface + +sub dumpstore { + my ($namespace,$udomain,$uname,$regexp,$range)=@_; + return &dump($namespace,$udomain,$uname,$regexp,$range); +} + # -------------------------------------------------------------- keys interface sub getkeys { @@ -4718,7 +4739,7 @@ sub GetFileTimestamp { sub stat_file { my ($uri) = @_; - $uri = &clutter($uri); + $uri = '/'.&declutter($uri); my ($udom,$uname,$file,$dir); if ($uri =~ m-^/(uploaded|editupload)/-) { ($udom,$uname,$file) = @@ -4739,6 +4760,7 @@ sub stat_file { my ($result) = &dirlist($file,$udom,$uname,$dir); my @stats = split('&', $result); + if($stats[0] ne 'empty' && $stats[0] ne 'no_such_dir') { shift(@stats); #filename is first return @stats; @@ -5222,10 +5244,7 @@ sub check_group_parms { sub sort_course_groups { # Sort groups based on defined rankings. Default is sort(). my ($grouplist,$courseid) = @_; - my @groups = split/:/,$grouplist; - if (@groups > 1) { - @groups = sort(@groups); - } + my @groups = sort(split(/:/,$grouplist)); return @groups; } @@ -6429,7 +6448,7 @@ sub clutter { && $thisfn!~/\.(sequence|page)$/) { $thisfn='/adm/coursedocs/showdoc'.$thisfn; } else { - &logthis("Got a blank emb style"); +# &logthis("Got a blank emb style"); } } } @@ -7250,6 +7269,27 @@ all args are optional =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 works very similar to store/cstore, but all data is stored in a temporary location and can be reset using tmpreset, $storehash should @@ -7303,13 +7343,6 @@ put($namespace,$storehash,$udom,$uname) =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 * - cput($namespace,$storehash,$udom,$uname) : critical put ($udom and $uname are optional)