--- loncom/lonnet/perl/lonnet.pm 2006/03/04 04:25:31 1.716 +++ loncom/lonnet/perl/lonnet.pm 2006/03/27 23:00:18 1.722 @@ -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.722 2006/03/27 23:00:18 albertel 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"); @@ -843,6 +850,7 @@ sub save_cache { my ($r)=@_; if (! $r->is_initial_req()) { return DECLINED; } &purge_remembered(); + #&Apache::loncommon::validate_page(); undef(%env); return OK; } @@ -1320,7 +1328,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 +1339,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 +1362,7 @@ sub userfileupload { close($fh); return $fullpath.'/'.$fname; } + # Create the directory if not present $fname="$subdir/$fname"; if ($coursedoc) { @@ -1369,6 +1378,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 +2870,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 { @@ -4719,6 +4741,13 @@ sub GetFileTimestamp { sub stat_file { my ($uri) = @_; $uri = &clutter($uri); + + # we want just the url part without the unneeded accessor url bits + if ($file =~ m-^/adm/-) { + $file=~s-^/adm/wrapper/-/-; + $file=~s-^/adm/coursedocs/showdoc/-/-; + } + my ($udom,$uname,$file,$dir); if ($uri =~ m-^/(uploaded|editupload)/-) { ($udom,$uname,$file) = @@ -4739,6 +4768,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 +5252,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 +6456,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 +7277,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 +7351,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)