--- loncom/lonnet/perl/lonnet.pm 2004/06/30 12:33:47 1.517 +++ loncom/lonnet/perl/lonnet.pm 2004/09/15 20:41:07 1.523.2.2 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.517 2004/06/30 12:33:47 albertel Exp $ +# $Id: lonnet.pm,v 1.523.2.2 2004/09/15 20:41:07 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -50,7 +50,7 @@ use Fcntl qw(:flock); use Apache::loncoursedata; use Apache::lonlocal; use Storable qw(lock_store lock_nstore lock_retrieve freeze thaw); -use Time::HiRes(); +use Time::HiRes qw( gettimeofday tv_interval ); my $readit; =pod @@ -1047,6 +1047,7 @@ sub currentversion { sub subscribe { my $fname=shift; if ($fname=~/\/(aboutme|syllabus|bulletinboard|smppg)$/) { return ''; } + $fname=~s/[\n\r]//g; my $author=$fname; $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/; my ($udom,$uname)=split(/\//,$author); @@ -1067,6 +1068,7 @@ sub repcopy { my $filename=shift; $filename=~s/\/+/\//g; if ($filename=~/^\/home\/httpd\/html\/adm\//) { return OK; } + $filename=~s/[\n\r]//g; my $transname="$filename.in.transfer"; if ((-e $filename) || (-e $transname)) { return OK; } my $remoteurl=subscribe($filename); @@ -1282,6 +1284,22 @@ sub userfileupload { # See if there is anything left unless ($fname) { return 'error: no uploaded file'; } 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 my $docuname=''; my $docudom=''; @@ -1600,7 +1618,7 @@ sub getannounce { if ($announcement=~/\w/) { return ''. - '
'.$announcement.'
'; + ''.$announcement.''; } else { return ''; } @@ -3203,6 +3221,32 @@ sub auto_create_password { return ($authparam,$create_passwd,$authchk); } +sub auto_instcode_format { + my ($caller,$codedom,$instcodes,$codes,$codetitles,$cat_titles,$cat_order) = @_; + my $courses = ''; + my $homeserver; + if ($caller eq 'global') { + $homeserver = $perlvar{'lonHostID'}; + } else { + $homeserver = &homeserver($caller,$codedom); + } + my $host=$hostname{$homeserver}; + foreach (keys %{$instcodes}) { + $courses .= &escape($_).'='.&escape($$instcodes{$_}).'&'; + } + chop($courses); + my $response=&reply('autoinstcodeformat:'.$codedom.':'.$courses,$homeserver); + unless ($response =~ /(con_lost|error|no_such_host|refused)/) { + my ($codes_str,$codetitles_str,$cat_titles_str,$cat_order_str) = split/:/,$response; + %{$codes} = &str2hash($codes_str); + @{$codetitles} = &str2array($codetitles_str); + %{$cat_titles} = &str2hash($cat_titles_str); + %{$cat_order} = &str2hash($cat_order_str); + return 'ok'; + } + return $response; +} + # ------------------------------------------------------------------ Plain Text sub plaintext { @@ -3585,16 +3629,19 @@ sub revokecustomrole { # ------------------------------------------------------------ Portfolio Director Lister +# returns listing of contents of user's /userfiles/portfolio/ directory +# + sub portfoliolist { -#FIXME us the ls: command instead please -#FIXME uhome should never be an argument to any lonnet functions - # returns listing of contents of user's /userfiles/portfolio/ directory - # - my ($udom,$uname,$uhome); + my ($currentPath, $currentFile) = @_; + my ($udom, $uname, $portfolioRoot); $uname=$ENV{'user.name'}; $udom=$ENV{'user.domain'}; - $uhome=$ENV{'user.home'}; - my $listing = &reply('portls:'.$uname.':'.$udom, $uhome); + # really should interrogate the system for home directory information, but . . . + $portfolioRoot = '/home/httpd/lonUsers/'.$udom.'/'; + $uname =~ /^(.?)(.?)(.?)/; + $portfolioRoot = $portfolioRoot.$1.'/'.$2.'/'.$3.'/'.$uname.'/userfiles/portfolio'; + my $listing = &reply('ls:'.$portfolioRoot.$currentPath, &homeserver($uname,$udom)); return $listing; } @@ -3949,11 +3996,14 @@ sub EXT { my $section; if (defined($courseid) && $courseid eq $ENV{'request.course.id'}) { + if (!$symbparm) { $symbparm=&symbread(); } + } + if ($symbparm && defined($courseid) && + $courseid eq $ENV{'request.course.id'}) { #print '
'.$space.' - '.$qualifier.' - '.$spacequalifierrest; # ----------------------------------------------------- Cascading lookup scheme - if (!$symbparm) { $symbparm=&symbread(); } my $symbp=$symbparm; my $mapp=(&decode_symb($symbp))[0]; @@ -3964,11 +4014,11 @@ sub EXT { ($ENV{'user.domain'} eq $udom)) { $section=$ENV{'request.course.sec'}; } else { - if (! defined($usection)) { - $section=&usection($udom,$uname,$courseid); - } else { - $section = $usection; - } + if (! defined($usection)) { + $section=&usection($udom,$uname,$courseid); + } else { + $section = $usection; + } } my $seclevel=$courseid.'.['.$section.'].'.$spacequalifierrest; @@ -4006,7 +4056,7 @@ sub EXT { $uname." at ".$udom.": ". $tmp.""); } elsif ($tmp=~/error: 2 /) { - &EXT_cache_set($udom,$uname); + &EXT_cache_set($udom,$uname); } elsif ($tmp =~ /^(con_lost|no_such_host)/) { return $tmp; } @@ -4016,10 +4066,10 @@ sub EXT { # -------------------------------------------------------- second, check course my $coursereply=&courseresdata($ENV{'course.'.$courseid.'.num'}, - $ENV{'course.'.$courseid.'.domain'}, - ($seclevelr,$seclevelm,$seclevel, - $courselevelr,$courselevelm, - $courselevel)); + $ENV{'course.'.$courseid.'.domain'}, + ($seclevelr,$seclevelm,$seclevel, + $courselevelr,$courselevelm, + $courselevel)); if (defined($coursereply)) { return $coursereply; } # ------------------------------------------------------ third, check map parms @@ -4517,14 +4567,23 @@ sub deversion { sub symbread { my ($thisfn,$donotrecurse)=@_; + if (defined($ENV{'request.symbread.cached'})) { + return $ENV{'request.symbread.cached'}; + } # no filename provided? try from environment unless ($thisfn) { - if ($ENV{'request.symb'}) { return &symbclean($ENV{'request.symb'}); } + if ($ENV{'request.symb'}) { + $ENV{'request.symbread.cached'}=&symbclean($ENV{'request.symb'}); + return $ENV{'request.symbread.cached'}; + } $thisfn=$ENV{'request.filename'}; } # is that filename actually a symb? Verify, clean, and return if ($thisfn=~/\_\_\_\d+\_\_\_(.*)$/) { - if (&symbverify($thisfn,$1)) { return &symbclean($thisfn); } + if (&symbverify($thisfn,$1)) { + $ENV{'request.symbread.cached'}=&symbclean($thisfn); + return $ENV{'request.symbread.cached'}; + } } $thisfn=declutter($thisfn); my %hash; @@ -4545,6 +4604,7 @@ sub symbread { unless ($syval=~/\_\d+$/) { unless ($ENV{'form.request.prefix'}=~/\.(\d+)\_$/) { &appenv('request.ambiguous' => $thisfn); + $ENV{'request.symbread.cached'}=''; return ''; } $syval.=$1; @@ -4592,10 +4652,12 @@ sub symbread { } } if ($syval) { - return &symbclean($syval.'___'.$thisfn); + $ENV{'request.symbread.cached'}=&symbclean($syval.'___'.$thisfn); + return $ENV{'request.symbread.cached'}; } } &appenv('request.ambiguous' => $thisfn); + $ENV{'request.symbread.cached'}=''; return ''; } @@ -4899,7 +4961,6 @@ sub getfile { } } else { $lwpresp = &getuploaded('GET',$file,$cdom,$cnum,\$info,\$rtncode); - &logthis("return is $lwpresp"); if ($lwpresp ne 'ok') { my $ua=new LWP::UserAgent; my $request=new HTTP::Request('GET',&tokenwrapper($file)); @@ -4913,7 +4974,7 @@ sub getfile { my @parts = ($cdom,$cnum); if ($filename =~ m|^(.+)/[^/]+$|) { push @parts, split(/\//,$1); - } + } foreach my $part (@parts) { $path .= '/'.$part; if (!-e $path) {