| Subject: | possible bug in _process_flags() |
| Date: | Tue, 13 Jul 2010 15:15:05 -0700 |
| To: | bug-Net-IMAP-Simple [...] rt.cpan.org |
| From: | Hawk ExploreTalent <hawkexploretalent [...] gmail.com> |
Greetings Mr. Miller (or whoever is maintaining this package),
I'm working on a project to migrate email from one server to another using
IMAP. In my loop, my Perl script reads messages one at a time from the
source server and checks to see if the message is on the target server (just
the headers).
If the message isn't found on the target server, then the message flags are
pulled and the message is copied to the target server. During the operation
which reads the message flags from the source server, I get an error like
this:
GLOB(0xa34030)2010-07-13 13:57:31 unable to get flags for source msg #2:
warning unknown return string (id=174): )
There are two messages in this box, and all works well if I don't pull the
flags. However, I'm trying to maintain the seen/unseen nature of each
message so that the script can be run as many times as necessary to get all
the email migrated over and keep the read/unread state of each message.
In the source code for Net::IMAP::Simple.pl, the sub _process_flags calls
shift for $self as the first action (from @_ presumably), but $self is never
passed to _process_flags when it's called from elsewhere, such as from the
sub msg_flags. Is this right?
-Hawk
sub _process_flags {
my $self = shift;
return grep { m/^\\\w+\z/ }
map { split m/\s+/, $_ }
@_;
}
sub msg_flags {
my ( $self, $number ) = @_;
my @flags;
$self->{_waserr} = 1; # assume something went wrong.
# _send_cmd] 15 FETCH 12 (FLAGS)\r\n
# _process_cmd] * 12 FETCH (FLAGS (\Seen))\r\n
# _cmd_ok] * 12 FETCH (FLAGS (\Seen))\r\n
# _seterrstr] warning unknown return string (id=15): * 12 FETCH
(FLAGS (\Seen))\r\n
# _process_cmd] 15 OK Success\r\n
return $self->_process_cmd(
cmd => [ FETCH => qq[$number (FLAGS)] ],
final => sub {
return if $self->{_waserr};
wantarray ? @flags : "@flags";
},
process => sub {
if( $_[0] =~ m/\* $number FETCH \(FLAGS \(([^()]+?)\)\)/i ) {
@flags = $self->_process_flags($1);
delete $self->{_waserr};
}
},
);
}