view release on metacpan or  search on metacpan

lib/Net/IMAP/Server.pm  view on Meta::CPAN

    my @port  = $self->port;
    if ( $self->ssl_port ) {
        push @proto, "SSL";
        push @port,  $self->ssl_port;
    }
    local $Net::IMAP::Server::Server = $self;
    $self->SUPER::run(
        @_,
        proto => \@proto,
        port  => \@port,
    );
}

=head2 process_request

Accepts a client connection; this method is needed for the
L<Net::Server> infrastructure.

=cut

sub process_request {
    my $self   = shift;
    my $handle = $self->{server}{client};
    my $conn   = $self->connection_class->new(
        io_handle => $handle,
        server    => $self,
    );
    $self->connection($conn);
    $conn->handle_lines;
}

=head2 DESTROY

On destruction, ensure that we close all client connections and
listening sockets.

=cut

DESTROY {
    my $self = shift;
    $_->close for grep { defined $_ } @{ $self->connections };
    $self->server_close;
}

=head2 connections

Returns an arrayref of L<Net::IMAP::Server::Connection> objects which
are currently connected to the server.

=cut

sub connections {
    my $self = shift;
    return [ values %{$self->{connection}} ];
}

=head2 connection

Returns the currently active L<Net::IMAP::Server::Connection> object,
if there is one.  This is determined by examining the current
coroutine.

=cut

sub connection {
    my $class = shift;
    my $self  = ref $class ? $class : $Net::IMAP::Server::Server;
    if (@_) {
        if (defined $_[0]) {
            $self->{connection}{$Coro::current . ""} = shift;
        } else {
            delete $self->{connection}{$Coro::current . ""};
        }
    }
    return $self->{connection}{$Coro::current . ""};
}

=head2 concurrent_mailbox_connections [MAILBOX]

This can be called as either a class method or an instance method; it
returns the set of connections which are concurrently connected to the
given mailbox object (which defaults to the current connection's
selected mailbox)

=cut

sub concurrent_mailbox_connections {
    my $class    = shift;
    my $self     = ref $class ? $class : $Net::IMAP::Server::Server;
    my $selected = shift || $self->connection->selected;

    return () unless $selected;
    return
        grep { $_->is_auth and $_->is_selected and $_->selected eq $selected }
        @{ $self->connections };
}

=head2 concurrent_user_connections [USER]

This can be called as either a class method or an instance method; it
returns the set of connections whose
L<Net::IMAP::Server::DefaultAuth/user> is the same as the given
L<USER> (which defaults to the current connection's user)

=cut

sub concurrent_user_connections {
    my $class = shift;
    my $self  = ref $class ? $class : $Net::IMAP::Server::Server;
    my $user  = shift || $self->connection->auth->user;

    return () unless $user;
    return
        grep { $_->is_auth and $_->auth->user eq $user }
        @{ $self->connections };
}

=head2 capability

Returns the C<CAPABILITY> string for the server.  This string my be
modified by the connection before being sent to the client (see