[Bps-public-commit] r10552 - in Net-IMAP-Server: lib/Net/IMAP lib/Net/IMAP/Server lib/Net/IMAP/Server/Command

[alexmv at bestpractical.com]

Author: alexmv
Date: Tue Jan 29 12:05:29 2008
New Revision: 10552

Modified:
   Net-IMAP-Server/   (props changed)
   Net-IMAP-Server/lib/Net/IMAP/Server.pm
   Net-IMAP-Server/lib/Net/IMAP/Server/Command/Check.pm
   Net-IMAP-Server/lib/Net/IMAP/Server/Command/Select.pm
   Net-IMAP-Server/lib/Net/IMAP/Server/Connection.pm

Log:
 r27298 at zoq-fot-pik:  chmrr | 2008-01-29 12:05:02 -0500
  * Add polling interval support (defaults to every command, like previously)


Modified: Net-IMAP-Server/lib/Net/IMAP/Server.pm
==============================================================================
--- Net-IMAP-Server/lib/Net/IMAP/Server.pm	(original)
+++ Net-IMAP-Server/lib/Net/IMAP/Server.pm	Tue Jan 29 12:05:29 2008
@@ -58,7 +58,7 @@
 =cut
 
 __PACKAGE__->mk_accessors(
-    qw/connections port ssl_port auth_class model_class user group/);
+    qw/connections port ssl_port auth_class model_class user group poll_every/);
 
 =head2 new PARAMHASH
 
@@ -111,6 +111,7 @@
             ssl_port    => 0,
             auth_class  => "Net::IMAP::Server::DefaultAuth",
             model_class => "Net::IMAP::Server::DefaultModel",
+            poll_every  => 0,
             @_,
             connections => [],
         }

Modified: Net-IMAP-Server/lib/Net/IMAP/Server/Command/Check.pm
==============================================================================
--- Net-IMAP-Server/lib/Net/IMAP/Server/Command/Check.pm	(original)
+++ Net-IMAP-Server/lib/Net/IMAP/Server/Command/Check.pm	Tue Jan 29 12:05:29 2008
@@ -20,7 +20,7 @@
 
 sub run {
     my $self = shift;
-
+    $self->connection->poll;
     $self->ok_completed();
 }
 

Modified: Net-IMAP-Server/lib/Net/IMAP/Server/Command/Select.pm
==============================================================================
--- Net-IMAP-Server/lib/Net/IMAP/Server/Command/Select.pm	(original)
+++ Net-IMAP-Server/lib/Net/IMAP/Server/Command/Select.pm	Tue Jan 29 12:05:29 2008
@@ -26,6 +26,7 @@
 
     my $mailbox = $self->connection->model->lookup( $self->parsed_options );
     $mailbox->poll;
+    $self->connection->last_poll(time);
     $self->connection->selected($mailbox);
     $self->connection->selected_read_only(1) if $self->command eq "Examine";
 

Modified: Net-IMAP-Server/lib/Net/IMAP/Server/Connection.pm
==============================================================================
--- Net-IMAP-Server/lib/Net/IMAP/Server/Connection.pm	(original)
+++ Net-IMAP-Server/lib/Net/IMAP/Server/Connection.pm	Tue Jan 29 12:05:29 2008
@@ -8,11 +8,11 @@
 use Net::IMAP::Server::Command;
 use Coro;
 
-__PACKAGE__->mk_accessors(qw(server io_handle _selected selected_read_only model pending temporary_messages temporary_sequence_map previous_exists untagged_expunge untagged_fetch ignore_flags));
+__PACKAGE__->mk_accessors(qw(server io_handle _selected selected_read_only model pending temporary_messages temporary_sequence_map previous_exists untagged_expunge untagged_fetch ignore_flags last_poll));
 
 sub new {
     my $class = shift;
-    my $self = $class->SUPER::new( { @_, state => "unauth", untagged_expunge => [], untagged_fetch => {} } );
+    my $self = $class->SUPER::new( { @_, state => "unauth", untagged_expunge => [], untagged_fetch => {}, last_poll => time } );
     $self->greeting;
     return $self;
 }
@@ -160,17 +160,31 @@
     }
 }
 
+sub poll {
+    my $self = shift;
+    my($mbox) = @_;
+    $mbox ||= $self->selected;
+
+    $self->selected->poll;
+    $self->last_poll(time);
+}
+
+sub force_poll {
+    my $self = shift;
+    $self->last_poll(0);
+}
+
 sub send_untagged {
     my $self = shift;
     my %args = ( expunged => 1,
                  @_ );
     return unless $self->is_auth and $self->is_selected;
 
-    {
+    if (time > $self->last_poll + $self->server->poll_every) {
         # When we poll, the things that we find should affect this
         # connection as well; hence, the local to be "connection-less"
         local $Net::IMAP::Server::Server->{connection};
-        $self->selected->poll;
+        $self->poll;
     }
 
     for my $s (keys %{$self->untagged_fetch}) {