high performance branch

git-svn-id: https://svn.perl.org/qpsmtpd/branches/high_perf@386 958fd67b-6ff1-0310-b445-bb7760255be9

lib/Qpsmtpd.pm

@@ -4,6 +4,8 @@ use vars qw($VERSION $LogLevel);
 
 use Sys::Hostname;
 use Qpsmtpd::Constants;
+use Qpsmtpd::Transaction;
+use Qpsmtpd::Connection;
 
 $VERSION = "0.29";
 sub TRACE_LEVEL { $LogLevel }
@@ -196,10 +198,6 @@ sub _load_plugins {
   return @ret;
 }
 
-sub transaction {
-    return {}; # base class implements empty transaction
-}
-
 sub run_hooks {
   my ($self, $hook) = (shift, shift);
   my $hooks = $self->{hooks};
@@ -286,6 +284,22 @@ sub spool_dir {
   return $spool_dir;
 }
 
+sub transaction {
+    my $self = shift;
+    return $self->{_transaction} || $self->reset_transaction();
+}
+
+sub reset_transaction {
+    my $self = shift;
+    $self->run_hooks("reset_transaction") if $self->{_transaction};
+    return $self->{_transaction} = Qpsmtpd::Transaction->new();
+}
+
+sub connection {
+  my $self = shift;
+  return $self->{_connection} || ($self->{_connection} = Qpsmtpd::Connection->new());
+}
+
 # For unique filenames. We write to a local tmp dir so we don't need
 # to make them unpredictable.
 my $transaction_counter = 0; 

lib/Qpsmtpd/SMTP.pm

@@ -110,24 +110,6 @@ sub start_conversation {
     }
 }
 
-sub transaction {
-  my $self = shift;
-  return $self->{_transaction} || $self->reset_transaction();
-}
-
-sub reset_transaction {
-  my $self = shift;
-  $self->run_hooks("reset_transaction") if $self->{_transaction};
-  return $self->{_transaction} = Qpsmtpd::Transaction->new();
-}
-
-
-sub connection {
-  my $self = shift;
-  return $self->{_connection} || ($self->{_connection} = Qpsmtpd::Connection->new());
-}
-
-
 sub helo {
   my ($self, $hello_host, @stuff) = @_;
   return $self->respond (501,

lib/Qpsmtpd/Transaction.pm

@@ -15,6 +15,10 @@ sub start {
   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 @@ sub notes {
   $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_filename {
 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;
-  }
+  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_size {
 
 sub body_resetpos {
   my $self = shift;
-  return unless $self->{_body_file};
+  
+  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};
+  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 {