[svn:qpsmtpd] rev 385 - trunk/lib/Qpsmtpd

[email protected] 8 Mar 2005 18:09:49 -0000
Newsgroups perl.cvs.qpsmtpd
Message-ID <[email protected]>
Author: msergeant
Date: Tue Mar  8 10:09:49 2005
New Revision: 385

Modified:
   trunk/lib/Qpsmtpd/Transaction.pm
Log:
Store mail in memory up to a certain threshold (default 10k).


Modified: trunk/lib/Qpsmtpd/Transaction.pm
==============================================================================
--- trunk/lib/Qpsmtpd/Transaction.pm	(original)
+++ trunk/lib/Qpsmtpd/Transaction.pm	Tue Mar  8 10:09:49 2005
@@ -15,6 +15,10 @@
   my %args = @_;
   my $self = { _rcpt => [], started => time };
   bless ($self, $class);
+  my $sz = $self->config('memory_threshold');
+  $sz = 10_000 unless defined($sz);
+  $self->{_size_threshold} = $sz;
+  return $self;
 }
 
 sub add_recipient {
@@ -57,12 +61,26 @@
   $self->{_notes}->{$key};
 }
 
+sub set_body_start {
+    my $self = shift;
+    $self->{_body_start} = $self->body_current_pos;
+}
+
 sub body_start {
   my $self = shift;
-  @_ and $self->{_body_start} = shift;
+  @_ and die "body_start now read only";
   $self->{_body_start};
 }
 
+sub body_current_pos {
+    my $self = shift;
+    if ($self->{_body_file}) {
+        return tell($self->{_body_file});
+    }
+    return $self->{_body_current_pos} || 0;
+}
+
+# TODO - should we create the file here if we're storing as an array?
 sub body_filename {
   my $self = shift;
   return unless $self->{_body_file};
@@ -72,17 +90,41 @@
 sub body_write {
   my $self = shift;
   my $data = shift;
-  unless ($self->{_body_file}) {
-    $self->{_filename} = $self->temp_file();
-    $self->{_body_file} = IO::File->new($self->{_filename}, O_RDWR|O_CREAT, 0600)
-      or die "Could not open file $self->{_filename} - $! "; # . $self->{_body_file}->error;
-  }
-  # go to the end of the file
-  seek($self->{_body_file},0,2)
-    unless $self->{_body_file_writing};
-  $self->{_body_file_writing} = 1;
-  $self->{_body_file}->print(ref $data eq "SCALAR" ? $$data : $data)
-    and $self->{_body_size} += length (ref $data eq "SCALAR" ? $$data : $data); 
+  if ($self->{_body_file}) {
+    #warn("body_write to file\n");
+    # go to the end of the file
+    seek($self->{_body_file},0,2)
+      unless $self->{_body_file_writing};
+    $self->{_body_file_writing} = 1;
+    $self->{_body_file}->print(ref $data eq "SCALAR" ? $$data : $data)
+      and $self->{_body_size} += length (ref $data eq "SCALAR" ? $$data : $data);
+  }
+  else {
+    #warn("body_write to array\n");
+    $self->{_body_array} ||= [];
+    my $ref = ref($data) eq "SCALAR" ? $data : \$data;
+    pos($$ref) = 0;
+    while ($$ref =~ m/\G(.*?\n)/gc) {
+      push @{ $self->{_body_array} }, $1;
+      $self->{_body_size} += length($1);
+    }
+    if ($$ref =~ m/\G(.+)\z/gc) {
+      push @{ $self->{_body_array} }, $1;
+      $self->{_body_size} += length($1);
+    }
+    if ($self->{_body_size} >= $self->{_size_threshold}) {
+      #warn("spooling to disk\n");
+      $self->{_filename} = $self->temp_file();
+      $self->{_body_file} = IO::File->new($self->{_filename}, O_RDWR|O_CREAT, 0600)
+        or die "Could not open file $self->{_filename} - $! "; # . $self->{_body_file}->error;
+      if ($self->{_body_array}) {
+        foreach my $line (@{ $self->{_body_array} }) {
+          $self->{_body_file}->print($line) or die "Cannot print to temp file: $!";
+        }
+      }
+      $self->{_body_array} = undef;
+    }
+  }
 }
 
 sub body_size {
@@ -91,22 +133,46 @@
 
 sub body_resetpos {
   my $self = shift;
-  return unless $self->{_body_file};
-  my $start = $self->{_body_start} || 0;
-  seek($self->{_body_file}, $start, 0);
-  $self->{_body_file_writing} = 0;
+  
+  if ($self->{_body_file}) {
+    my $start = $self->{_body_start} || 0;
+    seek($self->{_body_file}, $start, 0);
+    $self->{_body_file_writing} = 0;
+  }
+  else {
+    $self->{_body_current_pos} = $self->{_body_start};
+  }
+  
   1;
 }
 
 sub body_getline {
   my $self = shift;
-  return unless $self->{_body_file};
-  my $start = $self->{_body_start} || 0;
-  seek($self->{_body_file}, $start,0)
-    if $self->{_body_file_writing};
-  $self->{_body_file_writing} = 0;
-  my $line = $self->{_body_file}->getline;
-  return $line;
+  if ($self->{_body_file}) {
+    my $start = $self->{_body_start} || 0;
+    seek($self->{_body_file}, $start,0)
+      if $self->{_body_file_writing};
+    $self->{_body_file_writing} = 0;
+    my $line = $self->{_body_file}->getline;
+    return $line;
+  }
+  else {
+    return unless $self->{_body_array};
+    my $line = $self->{_body_array}->[$self->{_body_current_pos}];
+    $self->{_body_current_pos}++;
+    return $line;
+  }
+}
+
+sub body_as_string {
+    my $self = shift;
+    $self->body_resetpos;
+    local $/;
+    my $str = '';
+    while (defined(my $line = $self->body_getline)) {
+        $str .= $line;
+    }
+    return $str;
 }
 
 sub DESTROY {