Joshua Hoblitt <[EMAIL PROTECTED]> writes:
> I would like the ability to set the "content" of an HTTP::Message
> object by passing in a ref to scalar. This would be a 1 x content
> savings of memory, which can be significant for large messages.
>
> This would require some re-pluming so that $mess->{_content} becomes
> a ref to scalar (instead of a scalar) and the addition of a mutator,
> eg. $mess->set_content_ref. It's too bad that lvalues are still
> problematic.
>
> Comments?
The LWP API does not use "set_" methods or lvalues. The value of the
content_ref attribute would be updated if you pass an argument to the
method.
I think this is a good idea since we already have the content_ref
method. I tried to implement it too since I thought it would be
trivial. The change got a lot bigger than trivial before I was happy
with how this interacted with the 'parts*' methods.
This is the patch I ended up with. It is likely to be part of the
next LWP release.
Regards,
Gisle
Index: lib/HTTP/Message.pm
===================================================================
RCS file: /cvsroot/libwww-perl/lwp5/lib/HTTP/Message.pm,v
retrieving revision 1.42
diff -u -p -r1.42 Message.pm
--- lib/HTTP/Message.pm 9 Apr 2004 15:07:04 -0000 1.42
+++ lib/HTTP/Message.pm 9 Jun 2004 10:53:50 -0000
@@ -75,7 +75,7 @@ sub clone
sub clear {
my $self = shift;
$self->{_headers}->clear;
- $self->{_content} = "";
+ $self->content("");
delete $self->{_parts};
return;
}
@@ -84,16 +84,33 @@ sub clear {
sub protocol { shift->_elem('_protocol', @_); }
sub content {
- my $self = shift;
- if (defined(wantarray) && !exists $self->{_content}) {
- $self->_content;
+
+ my $self = $_[0];
+ if (defined(wantarray)) {
+ $self->_content unless exists $self->{_content};
+ my $old = $self->{_content};
+ &_set_content if @_ > 1;
+ $old = $$old if ref($old) eq "SCALAR";
+ return $old;
}
- my $old = $self->{_content};
- if (@_) {
- $self->{_content} = shift;
- delete $self->{_parts};
+
+ if (@_ > 1) {
+ &_set_content;
+ }
+ else {
+ Carp::carp("Useless content call in void context") if $^W;
}
- $old;
+}
+
+sub _set_content {
+ my $self = $_[0];
+ if (ref($self->{_content}) eq "SCALAR") {
+ ${$self->{_content}} = $_[1];
+ }
+ else {
+ $self->{_content} = $_[1];
+ }
+ delete $self->{_parts} unless $_[2];
}
@@ -101,11 +118,18 @@ sub add_content
{
my $self = shift;
$self->_content unless exists $self->{_content};
- if (ref($_[0])) {
- $self->{'_content'} .= ${$_[0]}; # for backwards compatability
+ my $chunkref = \$_[0];
+ $chunkref = $$chunkref if ref($$chunkref); # legacy
+
+ my $ref = ref($self->{_content});
+ if (!$ref) {
+ $self->{_content} .= $$chunkref;
+ }
+ elsif ($ref eq "SCALAR") {
+ ${$self->{_content}} .= $$chunkref;
}
else {
- $self->{'_content'} .= $_[0];
+ Carp::croak("Can't append to $ref content");
}
delete $self->{_parts};
}
@@ -116,7 +140,14 @@ sub content_ref
my $self = shift;
$self->_content unless exists $self->{_content};
delete $self->{_parts};
- \$self->{'_content'};
+ my $old = \$self->{_content};
+ $old = $$old if ref($$old);
+ if (@_) {
+ my $new = shift;
+ Carp::croak("Setting content_ref to a non-ref") unless ref($new);
+ $self->{_content} = $new;
+ }
+ return $old;
}
@@ -144,7 +175,7 @@ sub headers_as_string { shift->{'_heade
sub parts {
my $self = shift;
- if (defined(wantarray) && !exists $self->{_parts}) {
+ if (defined(wantarray) && (!exists $self->{_parts} || ref($self->{_content}) eq
"SCALAR")) {
$self->_parts;
}
my $old = $self->{_parts};
@@ -160,7 +191,7 @@ sub parts {
$self->content_type("multipart/mixed");
}
$self->{_parts} = [EMAIL PROTECTED];
- delete $self->{_content};
+ _stale_content($self);
}
return @$old if wantarray;
return $old->[0];
@@ -174,15 +205,27 @@ sub add_part {
$self->content_type("multipart/mixed");
$self->{_parts} = [$p];
}
- elsif (!exists $self->{_parts}) {
+ elsif (!exists $self->{_parts} || ref($self->{_content}) eq "SCALAR") {
$self->_parts;
}
push(@{$self->{_parts}}, @_);
- delete $self->{_content};
+ _stale_content($self);
return;
}
+sub _stale_content {
+ my $self = shift;
+ if (ref($self->{_content}) eq "SCALAR") {
+ # must recalculate now
+ $self->_content;
+ }
+ else {
+ # just invalidate cache
+ delete $self->{_content};
+ }
+}
+
# delegate all other method calls the the _headers object.
sub AUTOLOAD
@@ -219,7 +262,7 @@ sub _parts {
die "Assert" unless @h;
my %h = @{$h[0]};
if (defined(my $b = $h{boundary})) {
- my $str = $self->{_content};
+ my $str = $self->content;
$str =~ s/\r?\n--\Q$b\E--\r?\n.*//s;
if ($str =~ s/(^|.*?\r?\n)--\Q$b\E\r?\n//s) {
$self->{_parts} = [map HTTP::Message->parse($_),
@@ -230,12 +273,13 @@ sub _parts {
elsif ($ct eq "message/http") {
require HTTP::Request;
require HTTP::Response;
- my $class = ($self->{_content} =~ m,^(HTTP/.*)\n,) ?
+ my $content = $self->content;
+ my $class = ($content =~ m,^(HTTP/.*)\n,) ?
"HTTP::Response" : "HTTP::Request";
- $self->{_parts} = [$class->parse($self->{_content})];
+ $self->{_parts} = [$class->parse($content)];
}
elsif ($ct =~ m,^message/,) {
- $self->{_parts} = [ HTTP::Message->parse($self->{_content}) ];
+ $self->{_parts} = [ HTTP::Message->parse($self->content) ];
}
$self->{_parts} ||= [];
@@ -247,7 +291,7 @@ sub _content {
my $self = shift;
my $ct = $self->header("Content-Type") || "multipart/mixed";
if ($ct =~ m,^\s*message/,i) {
- $self->{_content} = $self->{_parts}[0]->as_string($CRLF);
+ _set_content($self, $self->{_parts}[0]->as_string($CRLF), 1);
return;
}
@@ -292,9 +336,10 @@ sub _content {
$ct = HTTP::Headers::Util::join_header_words(@v);
$self->header("Content-Type", $ct);
- $self->{_content} = "--$boundary$CRLF" .
+ _set_content($self, "--$boundary$CRLF" .
join("$CRLF--$boundary$CRLF", @parts) .
- "$CRLF--$boundary--$CRLF";
+ "$CRLF--$boundary--$CRLF",
+ 1);
}
@@ -383,6 +428,8 @@ content buffer.
=item $mess->content_ref
+=item $mess->content_ref( \$content )
+
The content_ref() method will return a reference to content buffer string.
It can be more efficient to access the content this way if the content
is huge, and it can even be used for direct manipulation of the content,
@@ -392,6 +439,12 @@ for instance:
This example would modify the content buffer in-place.
+If an argument is passed it will setup the content to reference some
+external source. The content() and add_content() methods will
+automatically dereference scalar references passed this way. For
+other references content() will return the reference itself and
+add_content() will refuse to do anything.
+
=item $mess->parts
=item $mess->parts( @parts )
