version 1.521, 2004/07/06 18:02:33
|
version 1.525, 2004/08/05 16:59:29
|
Line 1131 sub ssi_body {
|
Line 1131 sub ssi_body {
|
my ($filelink,%form)=@_; |
my ($filelink,%form)=@_; |
my $output=($filelink=~/^http\:/?&externalssi($filelink): |
my $output=($filelink=~/^http\:/?&externalssi($filelink): |
&ssi($filelink,%form)); |
&ssi($filelink,%form)); |
$output=~s/^.*?\<body[^\>]*\>//si; |
|
$output=~s/(.*)\<\/body\s*\>.*?$/$1/si; |
|
$output=~ |
$output=~ |
s/\/\/ BEGIN LON\-CAPA Internal.+\/\/ END LON\-CAPA Internal\s//gs; |
s/\/\/ BEGIN LON\-CAPA Internal.+\/\/ END LON\-CAPA Internal\s//gs; |
|
$output=~s/^.*?\<body[^\>]*\>//si; |
|
$output=~s/(.*)\<\/body\s*\>.*?$/$1/si; |
return $output; |
return $output; |
} |
} |
|
|
Line 1282 sub userfileupload {
|
Line 1282 sub userfileupload {
|
# See if there is anything left |
# See if there is anything left |
unless ($fname) { return 'error: no uploaded file'; } |
unless ($fname) { return 'error: no uploaded file'; } |
chop($ENV{'form.'.$formname}); |
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 |
# Create the directory if not present |
my $docuname=''; |
my $docuname=''; |
my $docudom=''; |
my $docudom=''; |
Line 2575 sub put {
|
Line 2591 sub put {
|
return &reply("put:$udomain:$uname:$namespace:$items",$uhome); |
return &reply("put:$udomain:$uname:$namespace:$items",$uhome); |
} |
} |
|
|
|
# ---------------------------------------------------------- putstore interface |
|
|
|
sub putstore { |
|
my ($namespace,$storehash,$udomain,$uname)=@_; |
|
if (!$udomain) { $udomain=$ENV{'user.domain'}; } |
|
if (!$uname) { $uname=$ENV{'user.name'}; } |
|
my $uhome=&homeserver($uname,$udomain); |
|
my $items=''; |
|
my %allitems = (); |
|
foreach (keys %$storehash) { |
|
if ($_ =~ m/^([^\:]+):([^\:]+):([^\:]+)$/) { |
|
my $key = $1.':keys:'.$2; |
|
$allitems{$key} .= $3.':'; |
|
} |
|
$items.=$_.'='.&escape($$storehash{$_}).'&'; |
|
} |
|
foreach (keys %allitems) { |
|
$allitems{$_} =~ s/\:$//; |
|
$items.= $_.'='.$allitems{$_}.'&'; |
|
} |
|
$items=~s/\&$//; |
|
return &reply("put:$udomain:$uname:$namespace:$items",$uhome); |
|
} |
|
|
# ------------------------------------------------------ critical put interface |
# ------------------------------------------------------ critical put interface |
|
|
sub cput { |
sub cput { |
Line 4928 sub getfile {
|
Line 4968 sub getfile {
|
} |
} |
} else { |
} else { |
$lwpresp = &getuploaded('GET',$file,$cdom,$cnum,\$info,\$rtncode); |
$lwpresp = &getuploaded('GET',$file,$cdom,$cnum,\$info,\$rtncode); |
&logthis("return is $lwpresp"); |
|
if ($lwpresp ne 'ok') { |
if ($lwpresp ne 'ok') { |
my $ua=new LWP::UserAgent; |
my $ua=new LWP::UserAgent; |
my $request=new HTTP::Request('GET',&tokenwrapper($file)); |
my $request=new HTTP::Request('GET',&tokenwrapper($file)); |
Line 5903 put($namespace,$storehash,$udom,$uname)
|
Line 5942 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) |
|
|