--- loncom/lonnet/perl/lonnet.pm 2004/07/02 21:34:55 1.519 +++ loncom/lonnet/perl/lonnet.pm 2004/07/22 22:12:06 1.523 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.519 2004/07/02 21:34:55 banghart Exp $ +# $Id: lonnet.pm,v 1.523 2004/07/22 22:12:06 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -1282,6 +1282,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=''; @@ -3203,6 +3219,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 { @@ -3589,16 +3631,16 @@ sub revokecustomrole { # sub portfoliolist { - my ($currentPath, $currentFile) = @_; - my ($udom, $uname, $portfolioRoot); - $uname=$ENV{'user.name'}; + my ($currentPath, $currentFile) = @_; + my ($udom, $uname, $portfolioRoot); + $uname=$ENV{'user.name'}; $udom=$ENV{'user.domain'}; # 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; + my $listing = &reply('ls:'.$portfolioRoot.$currentPath, &homeserver($uname,$udom)); + return $listing; } sub portfoliomanage { @@ -4902,7 +4944,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));