Net::IMAP - A client interface to IMAP (Internet Message Access Protocol).

  Content-Type: text/plain; charset=us-ascii

#!/usr/local/bin/perl
#
# Copyright (c) 1997-1999 Kevin Johnson <kjj@pobox.com>.
#
# All rights reserved. This program is free software; you can
# redistribute it and/or modify it under the same terms as Perl
# itself.
#
# $Id: IMAP.pm,v 1.2 1999/10/03 14:56:21 kjj Exp $

require 5.005;

package Net::IMAP;

use strict;

use Net::xAP;
use Carp;
use MIME::Base64;
use Digest::HMAC_MD5 qw(hmac_md5 hmac_md5_hex);

use vars qw($VERSION @ISA $AUTOLOAD);

$VERSION = "0.02";

@ISA = qw(Net::xAP);

use constant ATOM => Net::xAP::ATOM;
use constant ASTRING => Net::xAP::ASTRING;
use constant PARENS => Net::xAP::PARENS;
use constant SASLRESP => Net::xAP::SASLRESP;

use constant IMAP_STATE_NOT_AUTH => 1;
use constant IMAP_STATE_AUTH => 2;
use constant IMAP_STATE_SELECT => 4;
use constant IMAP_STATE_ANY => 7;

my %untagged_callbacks = (
			  'ok' => [\&_default_aux_callback],
			  'bye' => [\&_default_aux_callback],
			  'bad' => [\&_default_aux_callback],
			  'no' => [\&_default_aux_callback],
			  'capability' => [undef],
			  'list' => [undef],
			  'lsub' => [undef],
			  'status' => [undef],
			  'search' => [undef],
			  'flags' => [undef],
			  'exists' => [undef],
			  'recent' => [undef],
			  'expunge' => [undef],
			  'fetch' => [undef],
			  'namespace' => [undef],
			  'acl' => [undef],
			  'listrights' => [undef],
			  'myrights' => [undef],
			  'quota' => [undef],
			  'quotaroot' => [undef],
			 );

my %cmd_callbacks = (
		     'noop' => [undef, IMAP_STATE_ANY],
		     'capability' => [undef, IMAP_STATE_ANY],
		     'logout' => [undef, IMAP_STATE_ANY],
		     'authenticate' => ['_login_cmd_callback',
					IMAP_STATE_NOT_AUTH],
		     'login' => ['_login_cmd_callback', IMAP_STATE_NOT_AUTH],
		     'select' => ['_select_cmd_callback',
				  IMAP_STATE_AUTH|IMAP_STATE_SELECT],
		     'examine' => ['_select_cmd_callback',
				   IMAP_STATE_AUTH|IMAP_STATE_SELECT],
		     'create' => [undef, IMAP_STATE_AUTH|IMAP_STATE_SELECT],
		     'delete' => [undef, IMAP_STATE_AUTH|IMAP_STATE_SELECT],
		     'rename' => [undef, IMAP_STATE_AUTH|IMAP_STATE_SELECT],
		     'subscribe' => [undef, IMAP_STATE_AUTH|IMAP_STATE_SELECT],
		     'list' => [undef, IMAP_STATE_AUTH|IMAP_STATE_SELECT],
		     'lsub' => [undef, IMAP_STATE_AUTH|IMAP_STATE_SELECT],
		     'status' => [undef, IMAP_STATE_AUTH|IMAP_STATE_SELECT],
		     'append' => [undef, IMAP_STATE_AUTH|IMAP_STATE_SELECT],
		     'check' => [undef, IMAP_STATE_SELECT],
		     'close' => ['_close_cmd_callback', IMAP_STATE_SELECT],
		     'expunge' => [undef, IMAP_STATE_SELECT],
		     'search' => [undef, IMAP_STATE_SELECT],
		     'fetch' => [undef, IMAP_STATE_SELECT],
		     'store' => [undef, IMAP_STATE_SELECT],
		     'copy' => [undef, IMAP_STATE_SELECT],
		     'uid copy' => [undef, IMAP_STATE_SELECT],
		     'uid fetch' => [undef, IMAP_STATE_SELECT],
		     'uid search' => [undef, IMAP_STATE_SELECT],
		     'uid store' => [undef, IMAP_STATE_SELECT],
		     # Extension commands:
		     'namespace' => [undef, IMAP_STATE_AUTH|IMAP_STATE_SELECT],
		     'setacl' => [undef, IMAP_STATE_AUTH|IMAP_STATE_SELECT],
		     'getacl' => [undef, IMAP_STATE_AUTH|IMAP_STATE_SELECT],
		     'deleteacl' => [undef, IMAP_STATE_AUTH|IMAP_STATE_SELECT],
		     'listrights' => [undef,
				      IMAP_STATE_AUTH|IMAP_STATE_SELECT],
		     'myrights' => [undef, IMAP_STATE_AUTH|IMAP_STATE_SELECT],
		     'getquota' => [undef, IMAP_STATE_AUTH|IMAP_STATE_SELECT],
		     'setquota' => [undef, IMAP_STATE_AUTH|IMAP_STATE_SELECT],
		     'getquotaroot' => [undef,
					IMAP_STATE_AUTH|IMAP_STATE_SELECT],
		     'uid expunge' => [undef, IMAP_STATE_SELECT],
		    );

my %_system_flags = (
		     '\seen' => 1,
		     '\answered' => 1,
		     '\flagged' => 1,
		     '\deleted' => 1,
		     '\draft' => 1,
		     '\recent' => 1,
		    );

sub new {
  my $class = shift;
  my $type = ref($class) || $class;
  my $host = shift if @_ % 2;
  my %options = @_;

  my $self = Net::xAP->new($host, 'imap2(143)', Timeout => 10, %options)
    or return undef;

  bless $self, $class;

  $self->{Options}{EOL} ||= 'lf';
  $self->{Options}{EOL} = lc($self->{Options}{EOL}); # force lower-case

  $self->{PreAuth} = 0;
  $self->{Banner} = undef;
  $self->{Capabilities} = ();
  $self->_init_mailbox;
  $self->{Disconnect} = 0;
  $self->{State} = IMAP_STATE_NOT_AUTH;

  $self->{ResponseCallback} = $self->imap_response_callback;

  STDERR->autoflush(1);

  $self->_get_banner or return undef;

  # the little back-flip here with the Synchronous option ensures that
  # the capability command is issued in Synchronous mode

  my $mode = $self->{Options}{Synchronous}; # save current sync mode
  $self->{Options}{Synchronous}++; # force sync mode on
  my $resp = $self->capability;
  $self->{Options}{Synchronous} = $mode; # restore previous sync mode

  if ($resp->status ne 'ok') {
    carp "capability command failed on initial connection";
    $self->close_connection or carp "error closing connection: $!";
    $! = 5;			# *sigh* error reporting needs to be improved
    return undef;
  }

  return $self;
}

sub _init_mailbox {
  my $self = shift;
  $self->{Mailbox} = '';
  $self->{MailboxStatus} = ();
  $self->{MailboxStatus}{'recent'} = 0;
  $self->{MailboxStatus}{'unseen'} = 0;
  $self->{MailboxStatus}{'exists'} = 0;
  $self->{MailboxStatus}{'uidvalidity'} = 0;
  $self->{MailboxStatus}{'uidnext'} = 0;
  $self->{MailboxStatus}{'flags'} = ();
}

sub debug_text { $_[2] =~ /^(\d+ LOGIN [^\s]+)/i ? "$1 ..." : $_[2] }

sub _get_banner {
  my $self = shift;
  my $str = $self->getline;

  my $list = $self->parse_fields($str);
  return undef unless defined($list);

  if (($list->[0] eq '*') && ($list->[1] =~ /^preauth$/i)) {
    $self->{PreAuth}++;
    $self->{State} = IMAP_STATE_AUTH;
  } elsif (($list->[0] ne '*') || ($list->[1] !~ /^ok$/i)) {
    return undef;
  }
  my $supports_imap4rev1 = 0;
  for my $item (@{$list}) {
    $supports_imap4rev1++ if ($item =~ /^imap4rev1$/i);
  }
  unless ($supports_imap4rev1) {
    $self->close_connection;
    return undef;
  }

  $self->{Banner} = $list;

  return 1;
}

sub DESTROY {
  my $self = shift;
}

sub AUTOLOAD {
  my $self = shift;
  my $cmd = $AUTOLOAD;
  $cmd =~ s/^.*:://;
  carp("unknown command: $cmd");
  return undef;
}

###############################################################################

sub noop { $_[0]->imap_command('noop') }

sub capability { $_[0]->imap_command('capability') }

sub logout {
  $_[0]->{Disconnect}++;
  $_[0]->imap_command('logout');
}

sub login { $_[0]->imap_command('login', ASTRING, $_[1], ASTRING, $_[2]) }

my %auth_funcs = (
  'LOGIN' => \&authenticate_login,
  'CRAM-MD5' => \&authenticate_cram,
  'ANONYMOUS' => \&authenticate_anonymous,
);

my @auth_strings;

sub authenticate {
  my $authtype = uc($_[1]);
  return undef unless defined($auth_funcs{$authtype});
  return undef unless defined($_[0]->has_authtype($authtype));
  my $func = $auth_funcs{$authtype};
  @auth_strings = @_[2..$#_];
  $_[0]->imap_command('authenticate',
		      ATOM, $authtype,
		      SASLRESP, $func);
}

sub authenticate_login {
  my $i = shift;

  return undef unless defined($auth_strings[$i]);
  return encode_base64($auth_strings[$i], '');
}

sub authenticate_cram {
  my $i = shift;
  my $challenge = shift;

  if ($i == 0) {
    $challenge = decode_base64($challenge);
    $challenge = hmac_md5_hex($challenge, $auth_strings[1]);
    $auth_strings[1] = undef;
    return(encode_base64("$auth_strings[0] $challenge", ''));
  }
  return undef;
}

sub authenticate_anonymous {
  my $i = shift;
  return(encode_base64(join(' ', @auth_strings), '')) if ($i == 0);
  return undef;
}

sub select {
  $_[0]->{Mailbox} = $_[1];
  my $ret = $_[0]->imap_command('select', ASTRING, _encode_mailbox($_[1]));
  $_[0]->{Mailbox} = '' unless defined($ret);
  return $ret;
}

sub examine { $_[0]->imap_command('examine', ASTRING, _encode_mailbox($_[1])) }

sub create {
  my @args = (ASTRING, _encode_mailbox($_[1]));
  push @args, ATOM, $_[2] if (defined($_[2]));
  $_[0]->imap_command('create', @args);
}

sub delete {
  return undef if ($_[0]->{Mailbox} eq $_[1]);
  $_[0]->imap_command('delete', ASTRING, _encode_mailbox($_[1]));
}

sub rename {
  my @args = (ASTRING, _encode_mailbox($_[1]), ASTRING, _encode_mailbox($_[2]));
  push @args, ATOM, $_[3] if defined($_[3]);
  $_[0]->imap_command('rename', @args);
}

sub subscribe { $_[0]->imap_command('subscribe',
				    ASTRING, _encode_mailbox($_[1])) }

sub unsubscribe { $_[0]->imap_command('unsubscribe',
				      ASTRING, _encode_mailbox($_[1])) }

sub list {
  return undef if ($_[2] eq '*');
  $_[0]->imap_command('list',
		      ASTRING, _encode_mailbox($_[1]),
		      ASTRING, _encode_mailbox($_[2]));
}

sub lsub { $_[0]->imap_command('lsub',
			       ASTRING, _encode_mailbox($_[1]),
			       ASTRING, _encode_mailbox($_[2])) }

sub status {
  my $self = shift;
  my $mailbox = shift;
  return undef if ($self->{Mailbox} eq $mailbox);
  $self->imap_command('status',
		      ASTRING, _encode_mailbox($mailbox), PARENS, [@_]);
}

sub append {
  my $self = shift;
  my $mailbox = shift;
  my $lit = shift;
  my %options = @_;
  my @args;

  push @args, ASTRING, _encode_mailbox($mailbox);

  if (defined($options{Flags})) {
    for my $flag (@{$options{Flags}}) {
      unless ($self->_valid_flag($flag)) {
	carp "$flag is not a system flag";
	return undef;
      }
    }
    push @args, PARENS, [@{$options{Flags}}];
  }
  if (defined($options{Date})) {
    my $date;
    if ((ref($options{Date}) eq 'ARRAY')
	&& defined($options{Date}->[1])){
      my @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
      my @gmtime = gmtime($options{Date}->[0]);
      $date = sprintf("%02d-%2s-%4d %02d:%02d:%02d %s",
		      $gmtime[3], $months[$gmtime[4]], $gmtime[5] + 1900,
		      $gmtime[2], $gmtime[1], $gmtime[0],
		      $options{Date}->[1]);
    } else {
      $date = $options{Date};
    }
    if ($date !~ /^[ \d][\d]-[a-zA-Z]{3}-\d{4} \d\d:\d\d:\d\d [\+\-]\d{4}$/) {
      carp "invalid date value for append command";
      return undef;
    }
    push @args, ATOM, "\"$date\"";
  }
  $lit =~ s/\n/\r\n/mg if ($self->{Options}{EOL} eq 'lf');
  push @args, ASTRING, $lit;

  $self->imap_command('append', @args);
}

sub check { $_[0]->imap_command('check') }

sub close { $_[0]->imap_command('close') }

sub expunge {
  return undef if $_[0]->is_readonly;
  $_[0]->imap_command('expunge');
}

sub search {
  my $self = shift;
  my @args;
  if ($_[0] =~ /^charset$/i) {
    shift;
    my $charset = shift;
    push @args, ATOM, 'charset', ASTRING, $charset;
  }
  push @args, map { (ATOM, $_) } @_;
  $self->imap_command('search', @args);
}

sub fetch {
  my $self = shift;
  my $msgset = shift;
  my @args;
  if (scalar(@_) == 1) {
    push @args, ATOM, shift;
  } else {
    push @args, PARENS, [@_];
  }
  $self->imap_command('fetch', ATOM, $msgset, @args);
}

sub store {
  my $self = shift;
  my $msgset = shift;
  my $itemname = shift;
  for my $flag (@_) {
    unless ($self->_valid_flag($flag)) {
      carp "$flag is not a system flag";
      return undef;
    }
  }
  $self->imap_command('store', ATOM, $msgset, ATOM, $itemname, PARENS, [@_]);
}

sub copy { $_[0]->imap_command('copy',
			       ATOM, $_[1], ASTRING, _encode_mailbox($_[2])) }

sub uid_copy { $_[0]->imap_command('uid copy',
				   ATOM, $_[1],
				   ASTRING, _encode_mailbox($_[2])) }

sub uid_fetch {
  my $self = shift;
  my $msgset = shift;
  my @args;
  if (scalar(@_) == 1) {
    push @args, ATOM, shift;
  } else {
    push @args, PARENS, [@_];
  }
  $self->imap_command('uid fetch', ATOM, $msgset, @args);
}

sub uid_search {
  my $self = shift;
  my @args;
  if ($_[0] =~ /^charset$/i) {
    shift;
    my $charset = shift;
    push @args, ATOM, 'charset', ASTRING, $charset;
  }
  push @args, map { (ATOM, $_) } @_;
  $self->imap_command('uid search', @args);
}

sub uid_store {
  my $self = shift;
  my $msgset = shift;
  my $itemname = shift;
  for my $flag (@_) {
    unless ($self->_valid_flag($flag)) {
      carp "$flag is not a system flag";
      return undef;
    }
  }
  $self->imap_command('uid store',
		      ATOM, $msgset, ATOM, $itemname, PARENS, [@_]);
}
###############################################################################

sub is_preauth { $_[0]->{PreAuth} }

sub banner { $_[0]->{Banner} }

sub capabilities { keys %{$_[0]->{Capabilities}} }

sub has_capability { defined($_[0]->{Capabilities}{uc($_[1])}) }

sub authtypes { keys %{$_[0]->{AuthTypes}} }

sub has_authtype { defined($_[0]->{AuthTypes}{uc($_[1])}) }

sub qty_messages { $_[0]->{MailboxStatus}{'exists'} }

sub qty_recent { $_[0]->{MailboxStatus}{'recent'} }

sub first_unseen { $_[0]->{MailboxStatus}{'unseen'} }

sub uidvalidity { $_[0]->{MailboxStatus}{'uidvalidity'} }

sub uidnext { $_[0]->{MailboxStatus}{'uidnext'} }

sub permanentflags { keys %{$_[0]->{MailboxStatus}{'permanentflags'}} }

sub is_permanentflag {
  defined($_[0]->{MailboxStatus}{'permanentflags'}{lc($_[1])});
}

sub flags { keys %{$_[0]->{MailboxStatus}{'flags'}} }

sub has_flag { defined($_[0]->{MailboxStatus}{'flags'}{lc($_[1])}) }

sub mailbox { $_[0]->{Mailbox} }

sub is_readonly { $_[0]->{ReadOnly} }

#------------------------------------------------------------------------------

sub _encode_mailbox {
  my $str = $_[0];
  $str =~ s/&/&-/g;
  return $str;
}

sub _decode_mailbox {
  my $str = $_[0];
  $str =~ s/&-/&/g;
  return $str;
}

###############################################################################

sub namespace {
  my $self = shift;
  return undef unless $self->has_capability('NAMESPACE');
  $self->imap_command('namespace');
}

###############################################################################

sub setacl {
  my $self = shift;
  return undef unless $self->has_capability('ACL');
  $self->imap_command('setacl',
		      ASTRING, _encode_mailbox($_[0]),
		      ASTRING, $_[1],
		      ASTRING, $_[2]);
}

sub getacl {
  my $self = shift;
  return undef unless $self->has_capability('ACL');
  $self->imap_command('getacl', ASTRING, _encode_mailbox($_[0]));
}

sub deleteacl {
  my $self = shift;
  return undef unless $self->has_capability('ACL');
  $self->imap_command('deleteacl',
		      ASTRING, _encode_mailbox($_[0]), ASTRING, $_[1]);
}

sub listrights {
  my $self = shift;
  return undef unless $self->has_capability('ACL');
  $self->imap_command('listrights',
		      ASTRING, _encode_mailbox($_[0]), ASTRING, $_[1]);
}

sub myrights {
  my $self = shift;
  return undef unless $self->has_capability('ACL');
  $self->imap_command('myrights', ASTRING, _encode_mailbox($_[0]));
}

###############################################################################

sub getquota {
  my $self = shift;
  return undef unless $self->has_capability('QUOTA');
  $self->imap_command('getquota', ASTRING, $_[0]);
}

sub setquota {
  my $self = shift;
  my $quotaroot = shift;
  return undef unless $self->has_capability('QUOTA');
  $self->imap_command('setquota', ASTRING, $quotaroot, PARENS, [@_]);
}

sub getquotaroot {
  return undef unless $_[0]->has_capability('QUOTA');
  $_[0]->imap_command('getquotaroot', ASTRING, _encode_mailbox($_[1]));
}

###############################################################################

sub uid_expunge {
  return undef unless $_[0]->has_capability('UIDPLUS');
  $_[0]->imap_command('uid expunge', ATOM, $_[1]);
}

###############################################################################

sub imap_command {
  my $self = shift;
  if (!defined($cmd_callbacks{$_[0]})) {
    carp("unknown imap command: $_[0]");
    return undef;
  }
  unless ($cmd_callbacks{$_[0]}->[1] & $self->{State}) {
    carp("invalid state for issuing $_[0] command");
    return undef
  }
  $self->command($self->imap_cmd_callback($_[0]), @_);
}

###############################################################################

sub set_untagged_callback {
  my $self = shift;
  my $item = shift;
  my $funcref = shift;

  return undef unless defined($untagged_callbacks{$item});
  $untagged_callbacks{$item}->[0] = $funcref;
}

#------------------------------------------------------------------------------

sub imap_cmd_callback {
  my $self = shift;
  my $cmd = shift;
  return sub {
    my $resp = shift;
    return unless (defined($cmd_callbacks{$cmd})
		   && defined($cmd_callbacks{$cmd}->[0]));
    my $func = $cmd_callbacks{$cmd}->[0];
    return $self->$func($resp);
  }
}

sub imap_response_callback {
  my $self = shift;
  # my $seq = $self->next_sequence;
  return sub {
    my $response = shift;
    my ($tag, $rest) = split(/\s/, $response, 2);
    if ($tag eq '*') {
      return $self->_imap_process_untagged_response($rest);
    } elsif ($tag =~ /^\d+$/) {
      return $self->_imap_process_tagged_response($tag, $rest);
    } else {
      croak("gack! server returned bogus tag: [$tag]");
    }
  }
}

sub _imap_process_untagged_response {
  my $self = shift;
  my $str = shift;
  my @args;
  my $num;

  my ($cmd, $rest) = split(/\s/, $str, 2);
  if ($cmd =~ /^\d+$/) {
    push @args, $cmd;
    ($cmd, $rest) = split(/\s/, $rest, 2);
  }
  push @args, $rest if defined($rest);
  $cmd = lc($cmd);
  if (defined($untagged_callbacks{$cmd})) {
    my $class = "Net::IMAP::" . ucfirst(lc($cmd));
    my $ret = $class->new($self, @args);

    # trigger a user callback, maybe - user callback is passed $self
    # and the object created by the internal callback

    if (defined($ret)) {
      if (defined($untagged_callbacks{$cmd}->[0])) {
	&{$untagged_callbacks{$cmd}->[0]}($self, $ret);
      }
      $self->debug_print(0, "untagged resp callback returned $ret")
	if $self->debug;
    } else {
      carp("untagged resp callback returned undef");
    }
    return undef;
  } else {
    carp("received unknown response from server: [$cmd]\n");
  }
}

sub _imap_process_tagged_response {
  my $self = shift;
  my $tag = shift;
  my $str = shift;

  my $resp = Net::IMAP::Response->new;

  my ($cond, $text) = split(/\s/, $str, 2);
  my $resp_code = undef;
  if (substr($text, 0, 1) eq '[') {
    ($resp_code, $text) = _extract_resp_code($text);
  }
  $resp->{Sequence} = $tag;
  $resp->{Status} = lc($cond);
  $resp->{StatusCode} = $resp_code;
  $resp->{Text} = $text;

  if ($self->{Disconnect}) {
    $self->close_connection or carp "error closing connection: $!";
  }
  return $resp;
}
###############################################################################
sub _select_cmd_callback {
  my $self = shift;
  my $resp = shift;

  if ($resp->status eq 'ok') {
    $self->{State} = IMAP_STATE_SELECT;
    my $status = $resp->status_code;
    $self->{ReadOnly} = (defined($status) && ($status->[0] eq 'read-only'));
  } else {
    $self->{State} = IMAP_STATE_AUTH;
    $self->{Mailbox} = '';
  }
}

sub _login_cmd_callback {
  $_[0]->{State} = IMAP_STATE_AUTH if ($_[1]->status eq 'ok');
}

sub _close_cmd_callback {
  if ($_[1]->status eq 'ok') {
    $_[0]->_init_mailbox;
    $_[0]->{State} = IMAP_STATE_AUTH;
  }
}
#------------------------------------------------------------------------------

sub _default_aux_callback {
  my $self = shift;
  my $resp = shift;

  my $code = $resp->code;
  if (defined($code) && ($code->[0] eq 'alert')) {
    carp "Alert: ", $resp->text, "\n";
  }
}

###############################################################################
sub _valid_flag { ((substr($_[1], 0, 1) ne "\\")
		   || defined($_system_flags{lc($_[1])})) }
###############################################################################
sub _extract_resp_code {
  my $line = shift;
  $line =~ m{
	     	     \[
	     	     ([^\]]+)		# response code
	     	     \]
	     	     (?:
	      	      \s
	      	      (.*)		# remainder of response line
	     	     )?
	     	     $
	    	    }x;
  my $resp_code = $1;
  my $rest = $2;
  my $resp_code_list = Net::xAP->parse_fields($resp_code);
  $resp_code_list->[0] = lc($resp_code_list->[0]);
  return($resp_code_list, $rest);
}
###############################################################################
# use Data::Dumper;
# sub _dump_internals { print STDERR "----\n", Dumper($_[0]), "----\n" }
###############################################################################

package Net::IMAP::Response;
use vars qw(@ISA);
@ISA = qw(Net::xAP::Response);

sub is_tagged { 1 }

sub has_trycreate {
  my $status_code = $_[0]->status_code;
  return (defined($status_code) && (lc($status_code->[0]) eq 'trycreate'));
}

###############################################################################

package Net::IMAP::UntaggedResponse;

sub tag { '*' }
sub is_tagged { 0 }
sub parent { $_[0]->{Parent} }
#------------------------------------------------------------------------------
package Net::IMAP::Cond;
use vars qw(@ISA);
@ISA = qw(Net::IMAP::UntaggedResponse);
use Carp;

sub new {
  my $class = shift;
  my $type = ref($class) || $class;
  my $parent = shift;
  my $str = shift;

  my $self = {};

  bless $self, $class;

  $self->{Parent} = $parent;

  my $resp_code = undef;

  if (substr($str, 0, 1) eq '[') {
    ($resp_code, $str) = Net::IMAP::_extract_resp_code($str);
  }
  $self->{RespCode} = $resp_code;
  $self->{Text} = $str;

  carp "Alert: $str\n" if (defined($resp_code) && $resp_code->[0] eq 'alert');

  if (($self->name eq 'bye') && !$self->parent->{Disconnect}) {
    # a logout command wasn't issued, so it's probably the result of
    # an autologout timer expiring
    $self->parent->close_connection or carp "error closing connection: $!";
  }

  return $self;
}

sub code { $_[0]->{RespCode} }

sub name { undef }
#------------------------------------------------------------------------------

package Net::IMAP::Ok;
use vars qw(@ISA);
@ISA = qw(Net::IMAP::Cond);
sub name { 'ok' };
#------------------------------------------------------------------------------

package Net::IMAP::No;
use vars qw(@ISA);
@ISA = qw(Net::IMAP::Cond);
sub name { 'no' };
#------------------------------------------------------------------------------

package Net::IMAP::Bad;
use vars qw(@ISA);
@ISA = qw(Net::IMAP::Cond);
sub name { 'bad' };
#------------------------------------------------------------------------------

package Net::IMAP::Bye;
use vars qw(@ISA);
@ISA = qw(Net::IMAP::Cond);
sub name { 'bye' };
###############################################################################

package Net::IMAP::Expunge;
use vars qw(@ISA);
@ISA = qw(Net::IMAP::UntaggedResponse);

sub name { 'expunge' }

sub new {
  my $class = shift;
  my $type = ref($class) || $class;
  my $parent = shift;
  my $str = shift;

  my $self = {};

  bless $self, $class;

  $self->{Parent} = $parent;

  $self->{Msgnum} = $str;

  return $self;
}

sub msgnum { $_->{Msgnum} }

###############################################################################

package Net::IMAP::Capability;
use vars qw(@ISA);
@ISA = qw(Net::IMAP::UntaggedResponse);

sub name { 'capability' }

sub new {
  my $class = shift;
  my $type = ref($class) || $class;
  my $parent = shift;
  my $str = shift;

  my $self = {};

  bless $self, $class;

  $self->{Parent} = $parent;

  undef $self->{Parent}{Capabilities}; # needs to be repopulated each time
  undef $self->{Parent}{AuthTypes}; # needs to be repopulated each time

  for my $cap (split(/\s/, $str)) {
    $cap = uc($cap);
    $self->{Parent}{Capabilities}{$cap}++;
    $self->{Parent}{AuthTypes}{$1}++ if $cap =~ /^AUTH=(.*)$/;
    $self->{Capabilities}{$cap}++;
    $self->{AuthTypes}{$1}++ if $cap =~ /^AUTH=(.*)$/;
  }

  # force the non-synchronous literals option off if the server
  # doesn't support it
  $self->{Parent}{Options}{NonSyncLits} = 0
    unless defined($self->{Parent}{Capabilities}{'LITERAL+'});

  return $self;
}

sub capabilities { keys %{$_[0]->{Capabilities}} }

sub has_capability { defined($_[0]->{Capabilities}{uc($_[1])}) }

sub authtypes { keys %{$_[0]->{AuthTypes}} }

sub has_authtype { defined($_[0]->{AuthTypes}{uc($_[1])}) }

###############################################################################

package Net::IMAP::List;
use vars qw(@ISA);
@ISA = qw(Net::IMAP::UntaggedResponse);

sub name { 'list' }

sub new {
  my $class = shift;
  my $type = ref($class) || $class;
  my $parent = shift;
  my $str = shift;

  my $self = {};

  bless $self, $class;

  $self->{Parent} = $parent;

  my $fields = Net::xAP->parse_fields($str);
  for my $flag (@{$fields->[0]}) {
    $self->{Flags}{lc($flag)}++;
  }
  $self->{Delim} = $fields->[1];
  $self->{Mailbox} = Net::IMAP::_decode_mailbox($fields->[2]);

  return $self;
}

sub mailbox { $_[0]->{Mailbox} }
sub delimiter { $_[0]->{Delim} }
sub flags { keys %{$_[0]->{Flags}} }
sub has_flag { defined($_[0]->{Flags}{lc($_[1])}) }

#------------------------------------------------------------------------------

package Net::IMAP::Lsub;
use vars qw(@ISA);
@ISA = qw(Net::IMAP::List);

sub name { 'lsub' }

###############################################################################

package Net::IMAP::Fetch;
use vars qw(@ISA);
@ISA = qw(Net::IMAP::UntaggedResponse);

sub name { 'fetch' }

sub new {
  my $class = shift;
  my $type = ref($class) || $class;
  my $parent = shift;
  my $msgnum = shift;
  my $str = shift;

  my $self = {};

  bless $self, $class;

  $self->{Parent} = $parent;

  $self->{Msgnum} = $msgnum;

  my %hash = @{Net::xAP->parse_fields($str)->[0]};
  for my $key (keys %hash) {
    my $lckey = lc($key);
    print "$lckey $hash{$key}\n";
    if ($lckey eq 'envelope') {
      $self->{Items}{$lckey} = Net::IMAP::Envelope->new($hash{$key});
    } elsif (($lckey eq 'bodystructure') || ($lckey eq 'body')) {
      $self->{Items}{$lckey} = Net::IMAP::BodyStructure->new($hash{$key});
    } elsif ($lckey eq 'flags') {
      $self->{Items}{$lckey} = Net::IMAP::Flags->new($parent);
      for my $flag (@{$hash{$key}}) {
	$self->{Items}{$lckey}{Flags}{lc($flag)}++;
      }
    } else {
      if ($self->{Parent}{Options}{EOL} eq 'lf') {
	if ((substr($lckey, 0, 5) eq 'body[')
	    || ($lckey eq 'rfc822')
	    || ($lckey eq 'rfc822.header')
	    || ($lckey eq 'rfc822.text')) {
	  $hash{$key} =~ s/\r\n/\n/mg;
	}
      }
      $self->{Items}{$lckey} = $hash{$key};
    }
  }

  return $self;
}

sub msgnum { $_[0]->{Msgnum} }
sub items { keys %{$_[0]->{Items}} }
sub item { $_[0]->{Items}{lc($_[1])} }

###############################################################################

package Net::IMAP::Status;
use vars qw(@ISA);
@ISA = qw(Net::IMAP::UntaggedResponse);

sub name { 'status' }

sub new {
  my $class = shift;
  my $type = ref($class) || $class;
  my $parent = shift;
  my $str = shift;

  my $self = {};

  bless $self, $class;

  $self->{Parent} = $parent;

  my $fields = Net::xAP->parse_fields($str);
  $self->{Mailbox} = Net::IMAP::_decode_mailbox($fields->[0]);
  my %hash = @{$fields->[1]};
  for my $key (keys %hash) {
    $self->{Items}{lc($key)} = $hash{$key};
  }

  return $self;
}

sub mailbox { $_[0]->{Mailbox} }
sub items { keys %{$_[0]->{Items}} }
sub item { $_[0]->{Items}{lc($_[1])} }

###############################################################################

package Net::IMAP::Search;
use vars qw(@ISA);
@ISA = qw(Net::IMAP::UntaggedResponse);

sub name { 'search' }

sub new {
  my $class = shift;
  my $type = ref($class) || $class;
  my $parent = shift;
  my $str = shift;

  my $self = {};

  bless $self, $class;

  $self->{Parent} = $parent;

  for my $item (split(/\s/, $str)) {
    $self->{Msgnums}{$item}++;
  }

  return $self;
}

sub msgnums { keys %{$_[0]->{Msgnums}} }

###############################################################################

package Net::IMAP::Flags;
use vars qw(@ISA);
@ISA = qw(Net::IMAP::UntaggedResponse);

sub name { 'flags' }

sub new {
  my $class = shift;
  my $type = ref($class) || $class;
  my $parent = shift;
  my $str = shift;

  my $self = {};

  bless $self, $class;

  $self->{Parent} = $parent;

  if (defined($str)) {
    for my $flag (@{Net::xAP->parse_fields($str)->[0]}) {
      $self->{Flags}{lc($flag)}++;
      $self->{Parent}{MailboxStatus}{'flags'}{lc($flag)}++;
    }
  }

  return $self;
}

sub flags { keys %{$_[0]->{Flags}} }
sub has_flag { defined($_[0]->{Flags}{lc($_[1])}) }

###############################################################################

package Net::IMAP::Exists;
use vars qw(@ISA);
@ISA = qw(Net::IMAP::UntaggedResponse);

sub name { 'exists' }

sub new {
  my $class = shift;
  my $type = ref($class) || $class;
  my $parent = shift;
  my $str = shift;

  my $self = {};

  bless $self, $class;

  $self->{Parent} = $parent;

  $self->{Parent}{MailboxStatus}{'exists'} = $str;
  $self->{Value} = $str;

  return $self;
}

sub exists { $_[0]->{Value} }

###############################################################################

package Net::IMAP::Recent;
use vars qw(@ISA);
@ISA = qw(Net::IMAP::UntaggedResponse);

sub name { 'recent' }

sub new {
  my $class = shift;
  my $type = ref($class) || $class;
  my $parent = shift;
  my $str = shift;

  my $self = {};

  bless $self, $class;

  $self->{Parent} = $parent;

  $self->{Parent}{MailboxStatus}{'recent'} = $str;
  $self->{Value} = $str;

  return $self;
}

sub recent { $_[0]->{Value} }

###############################################################################

package Net::IMAP::Namespace;
use vars qw(@ISA);
@ISA = qw(Net::IMAP::UntaggedResponse);

sub name { 'namespace' }

my @namespace_types = qw(personal other_users shared);

sub new {
  my $class = shift;
  my $type = ref($class) || $class;
  my $parent = shift;
  my $str = shift;

  my $self = {};

  bless $self, $class;

  $self->{Parent} = $parent;

  my $fields = Net::xAP->parse_fields($str);
  for my $n (0 .. 2) {
    my $field = $fields->[$n];
    for my $item (@{$field}) {
      $item->[1] = '' if (lc($item->[1]) eq 'nil');
      $self->{Namespaces}{$namespace_types[$n]}{$item->[0]} = $item->[1];
    }
  }

  return $self;
}

sub personal {
  return $_[0]->{Namespaces}{'personal'}{lc($_[1])} if (defined($_[1]));
  keys %{$_[0]->{Namespaces}{'personal'}};
}

sub other_users {
  return $_[0]->{Namespaces}{'other_users'}{lc($_[1])} if (defined($_[1]));
  keys %{$_[0]->{Namespaces}{'other_users'}};
}

sub shared {
  return $_[0]->{Namespaces}{'shared'}{lc($_[1])} if (defined($_[1]));
  keys %{$_[0]->{Namespaces}{'shared'}};
}

###############################################################################

package Net::IMAP::Acl;
use vars qw(@ISA);
@ISA = qw(Net::IMAP::UntaggedResponse);

sub name { 'acl' }

sub new {
  my $class = shift;
  my $type = ref($class) || $class;
  my $parent = shift;
  my $str = shift;

  my $self = {};

  bless $self, $class;

  $self->{Parent} = $parent;

  my @fields = @{Net::xAP->parse_fields($str)};
  $self->{Mailbox} = shift(@fields);
  my %hash = @fields;
  for my $key (keys %hash) {
    $self->{Identifiers}{lc{$key}} = $hash{$key};
  }

  return $self;
}

sub mailbox { $_[0]->{Mailbox} }
sub identifiers { keys %{$_[0]->{Identifiers}} }
sub identifier { $_[0]->{Identifiers}{lc($_[1])} }

###############################################################################

package Net::IMAP::Listrights;
use vars qw(@ISA);
@ISA = qw(Net::IMAP::UntaggedResponse);

sub name { 'listrights' }

sub new {
  my $class = shift;
  my $type = ref($class) || $class;
  my $parent = shift;
  my $str = shift;

  my $self = {};

  bless $self, $class;

  $self->{Parent} = $parent;

  my @fields = @{Net::xAP->parse_fields($str)};
  $self->{Mailbox} = shift(@fields);
  $self->{Identifier} = shift(@fields);
  $self->{Rights} = [@fields];

  return $self;
}

sub mailbox { $_[0]->{Mailbox} }
sub identifier { $_[0]->{Identifier} }
sub rights { (wantarray) ? @{$_[0]->{Rights}} : $_[0]->{Rights} }

###############################################################################

package Net::IMAP::Myrights;
use vars qw(@ISA);
@ISA = qw(Net::IMAP::UntaggedResponse);

sub name { 'myrights' }

sub new {
  my $class = shift;
  my $type = ref($class) || $class;
  my $parent = shift;
  my $str = shift;

  my $self = {};

  bless $self, $class;

  $self->{Parent} = $parent;

  my $fields = Net::xAP->parse_fields($str);
  $self->{Mailbox} = $fields->[0];
  $self->{Rights} = $fields->[1];

  return $self;
}

sub mailbox { $_[0]->{Mailbox} }
sub rights { $_[0]->{Rights} }

###############################################################################

package Net::IMAP::Quota;
use vars qw(@ISA);
@ISA = qw(Net::IMAP::UntaggedResponse);

sub name { 'quota' }

sub new {
  my $class = shift;
  my $type = ref($class) || $class;
  my $parent = shift;
  my $str = shift;

  my $self = {};

  bless $self, $class;

  $self->{Parent} = $parent;

  my @fields = @{Net::xAP->parse_fields($str)};
  $self->{QuotaRoot} = shift(@fields);
  while (@fields) {
    my ($resource, $usage, $limit) = splice(@fields, 0, 3);
    $self->{Quota}{lc($resource)} = [$usage, $limit];
  }

  return $self;
}

sub quotaroot { $_[0]->{QuotaRoot} }
sub quotas { keys %{$_[0]->{Quotas}} }
sub usage { $_[0]->{Quotas}{lc($_[1])}->[0] }
sub limit { $_[0]->{Quotas}{lc($_[1])}->[1] }

###############################################################################

package Net::IMAP::Quotaroot;
use vars qw(@ISA);
@ISA = qw(Net::IMAP::UntaggedResponse);

sub name { 'quotaroot' }

sub new {
  my $class = shift;
  my $type = ref($class) || $class;
  my $parent = shift;
  my $str = shift;

  my $self = {};

  bless $self, $class;

  $self->{Parent} = $parent;

  my @fields = @{Net::xAP->parse_fields($str)};
  $self->{Mailbox} = shift(@fields);
  $self->{Quotaroots} = [@fields];

  return $self;
}

sub mailbox { $_[0]->{Mailbox} }
sub quotaroots { (wantarray) ? @{$_[0]->{Quotaroots}} : $_[0]->{Quotaroots} }

###############################################################################

package Net::IMAP::FetchData;

sub new {
  my $class = shift;
  my $type = ref($class) || $class;
  my $self = [];
  if (defined($_[0])) {
    push(@{$self},
	 map {
	   (lc($_) eq 'nil') ? undef : Net::xAP->dequote($_)
	 } @{$_[0]});
  }
  bless $self, $class;
}

###############################################################################