Net-IMAP-Client-0.9505/0000755000175000017500000000000012362255466013353 5ustar jrothjrothNet-IMAP-Client-0.9505/README0000644000175000017500000000161611115456157014232 0ustar jrothjrothNet-IMAP-Client - Not so simple IMAP client library Provides methods to access an IMAP server. See the POD. INSTALLATION To install this module, run the following commands: perl Makefile.PL make make test make install SUPPORT AND DOCUMENTATION After installing, you can find documentation for this module with the perldoc command. perldoc Net::IMAP::Client You can also look for information at: RT, CPAN's request tracker http://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-IMAP-Client AnnoCPAN, Annotated CPAN documentation http://annocpan.org/dist/Net-IMAP-Client CPAN Ratings http://cpanratings.perl.org/d/Net-IMAP-Client Search CPAN http://search.cpan.org/dist/Net-IMAP-Client COPYRIGHT AND LICENCE Copyright (C) 2008 Mihai Bazon This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Net-IMAP-Client-0.9505/Makefile.PL0000644000175000017500000000134311135052512015306 0ustar jrothjrothuse strict; use warnings; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'Net::IMAP::Client', AUTHOR => 'Mihai Bazon ', VERSION_FROM => 'lib/Net/IMAP/Client.pm', ABSTRACT_FROM => 'lib/Net/IMAP/Client.pm', PL_FILES => {}, PREREQ_PM => { 'Test::More' => 0, 'IO::Socket::INET' => 0, 'IO::Socket::SSL' => 0, 'List::Util' => 0, 'List::MoreUtils' => 0, 'Encode' => 0, 'Encode::MIME::Header' => 0, }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => 'Net-IMAP-Client-*' }, ); Net-IMAP-Client-0.9505/lib/0000755000175000017500000000000012362255466014121 5ustar jrothjrothNet-IMAP-Client-0.9505/lib/Net/0000755000175000017500000000000012362255466014647 5ustar jrothjrothNet-IMAP-Client-0.9505/lib/Net/IMAP/0000755000175000017500000000000012362255466015375 5ustar jrothjrothNet-IMAP-Client-0.9505/lib/Net/IMAP/Client.pm0000644000175000017500000016530512362255421017152 0ustar jrothjrothpackage Net::IMAP::Client; use vars qw[$VERSION]; $VERSION = '0.9505'; use strict; use warnings; use List::Util qw( min max first ); use List::MoreUtils qw( each_array ); use IO::Socket::INET (); use IO::Socket::SSL (); use Socket qw( SO_KEEPALIVE ); use Net::IMAP::Client::MsgSummary (); our $READ_BUFFER = 4096; my %UID_COMMANDS = map { $_ => 1 } qw( COPY FETCH STORE SEARCH SORT THREAD ); my %DEFAULT_ARGS = ( uid_mode => 1, timeout => 90, server => '127.0.0.1', port => undef, user => undef, pass => undef, ssl => 0, ssl_verify_peer => 1, socket => undef, _cmd_id => 0, ssl_options => {}, ); sub new { my ($class, %args) = @_; my $self = { map { $_ => exists $args{$_} ? $args{$_} : $DEFAULT_ARGS{$_} } keys %DEFAULT_ARGS }; bless $self, $class; $self->{notifications} = []; eval { $self->{greeting} = $self->_socket_getline; }; return $@ ? undef : $self; } sub DESTROY { my ($self) = @_; eval { $self->quit if $self->{socket}->opened; }; } sub uid_mode { my ($self, $val) = @_; if (defined($val)) { return $self->{uid_mode} = $val; } else { return $self->{uid_mode}; } } ### imap utilities ### sub login { my ($self, $user, $pass) = @_; $user ||= $self->{user}; $pass ||= $self->{pass}; $self->{user} = $user; $self->{pass} = $pass; _string_quote($user); _string_quote($pass); my ($ok) = $self->_tell_imap(LOGIN => "$user $pass"); return $ok; } sub logout { my ($self) = @_; $self->_send_cmd('LOGOUT'); $self->_get_socket->close; return 1; } *quit = \&logout; sub capability { my ($self, $requirement) = @_; my $capability = $self->{capability}; unless ($capability) { my ($ok, $lines) = $self->_tell_imap('CAPABILITY'); if ($ok) { my $line = $lines->[0][0]; if ($line =~ /^\*\s+CAPABILITY\s+(.*?)\s*$/) { $capability = $self->{capability} = [ split(/\s+/, $1) ]; } } } if ($requirement && $capability) { return first { $_ =~ $requirement } @$capability; } return $capability; } sub status { my $self = shift; my $a; my $wants_one = undef; if (ref($_[0]) eq 'ARRAY') { my @tmp = @{$_[0]}; $a = \@tmp; } else { $a = [ shift ]; $wants_one = 1; } foreach (@$a) { _string_quote($_); $_ = "STATUS $_ (MESSAGES RECENT UNSEEN UIDNEXT UIDVALIDITY)"; } my $results = $self->_tell_imap2(@$a); # remove "NO CLIENT BUG DETECTED" lines as they serve no # purpose beyond the religious zeal of IMAP implementors for my $row (@$results) { if (@{$row->[1]} > 1) { $row->[1] = [ grep { $_->[0] !~ /NO CLIENT BUG DETECTED: STATUS on selected mailbox:/ } @{$row->[1]} ]; } } my %ret; my $name; foreach my $i (@$results) { if ($i->[0]) { # was successful? my $tokens = _parse_tokens($i->[1]->[0]); $name = $tokens->[2]; $tokens = $tokens->[3]; my %tmp = @$tokens; $tmp{name} = $name; $ret{$name} = \%tmp; } } return $wants_one ? (defined $name and $ret{$name}) # avoid data on undef key : \%ret; } sub select { my ($self, $folder) = @_; $self->_select_or_examine($folder, 'SELECT'); } sub examine { my ($self, $folder) = @_; $self->_select_or_examine($folder, 'EXAMINE'); } sub _select_or_examine { my ($self, $folder, $operation) = @_; my $quoted = $folder; _string_quote($quoted); my ($ok, $lines) = $self->_tell_imap($operation => $quoted); if ($ok) { $self->{selected_folder} = $folder; my %info = (); foreach my $tmp (@$lines) { my $line = $tmp->[0]; if ($line =~ /^\*\s+(\d+)\s+EXISTS/i) { $info{messages} = $1 + 0; } elsif ($line =~ /^\*\s+FLAGS\s+\((.*?)\)/i) { $info{flags} = [ split(/\s+/, $1) ]; } elsif ($line =~ /^\*\s+(\d+)\s+RECENT/i) { $info{recent} = $1 + 0; } elsif ($line =~ /^\*\s+OK\s+\[(.*?)\s+(.*?)\]/i) { my ($flag, $value) = ($1, $2); if ($value =~ /\((.*?)\)/) { $info{sflags}->{$flag} = [split(/\s+/, $1)]; } else { $info{sflags}->{$flag} = $value; } } } $self->{FOLDERS} ||= {}; $self->{FOLDERS}{$folder} = \%info; } return $ok; } sub separator { my ($self) = @_; my $sep = $self->{separator}; if (!$sep) { my ($ok, $lines) = $self->_tell_imap(LIST => '"" ""'); if ($ok) { my $tokens = _parse_tokens($lines->[0]); $sep = $self->{separator} = $tokens->[3]; } else { $sep = undef; } } return $sep; } sub folders { my ($self) = @_; my ($ok, $lines) = $self->_tell_imap(LIST => '"" "*"'); if ($ok) { my @ret = map { _parse_tokens($_)->[4] } @$lines; return wantarray ? @ret : \@ret; } return undef; } sub _mk_namespace { my ($ns) = @_; if ($ns) { foreach my $i (@$ns) { $i = { prefix => $i->[0], sep => $i->[1], }; } } return $ns; } sub namespace { my ($self) = @_; my ($ok, $lines) = $self->_tell_imap('NAMESPACE'); if ($ok) { my $ret = _parse_tokens($lines->[0]); splice(@$ret, 0, 2); return { personal => _mk_namespace($ret->[0]), other => _mk_namespace($ret->[1]), shared => _mk_namespace($ret->[2]), }; } } sub folders_more { my ($self) = @_; my ($ok, $lines) = $self->_tell_imap(LIST => '"" "*"'); if ($ok) { my %ret = map { my $tokens = _parse_tokens($_); my $flags = $tokens->[2]; my $sep = $tokens->[3]; my $name = $tokens->[4]; ( $name, { flags => $flags, sep => $sep } ); } @$lines; return \%ret; } return undef; } sub noop { my ($self) = @_; my ($ok) = $self->_tell_imap('NOOP', undef, 1); return $ok; } sub seq_to_uid { my ($self, @seq_ids) = @_; my $ids = join(',', @seq_ids); my $save_uid_mode = $self->uid_mode; $self->uid_mode(0); my ($ok, $lines) = $self->_tell_imap(FETCH => "$ids UID", 1); $self->uid_mode($save_uid_mode); if ($ok) { my %ret = map { $_->[0] =~ /^\*\s+(\d+)\s+FETCH\s*\(\s*UID\s+(\d+)/ && ( $1, $2 ); } @$lines; return \%ret; } return undef; } sub search { my ($self, $criteria, $sort, $charset) = @_; $charset ||= 'UTF-8'; my $cmd = $sort ? 'SORT' : 'SEARCH'; if ($sort) { if (ref($sort) eq 'ARRAY') { $sort = uc '(' . join(' ', @$sort) . ')'; } elsif ($sort !~ /^\(/) { $sort = uc "($sort)"; } $sort =~ s/\s*$/ /; $sort =~ s/\^/REVERSE /g; } else { $charset = "CHARSET $charset"; $sort = ''; } if (ref($criteria) eq 'HASH') { my @a; while (my ($key, $val) = each %$criteria) { my $quoted = $val; # don't quote range _string_quote($quoted) unless uc $key eq 'UID'; push @a, uc $key, $quoted; } $criteria = '(' . join(' ', @a) . ')'; } my ($ok, $lines) = $self->_tell_imap($cmd => "$sort$charset $criteria", 1); if ($ok) { # it makes no sense to employ the full token parser here # read past progress messages lacking initial '*' foreach my $line (@{$lines->[0]}) { if ($line =~ s/^\*\s+(?:SEARCH|SORT)\s+//ig) { $line =~ s/\s*$//g; return [ map { $_ + 0 } split(/\s+/, $line) ]; } } } return undef; } sub get_rfc822_body { my ($self, $msg) = @_; my $wants_many = undef; if (ref($msg) eq 'ARRAY') { $msg = join(',', @$msg); $wants_many = 1; } my ($ok, $lines) = $self->_tell_imap(FETCH => "$msg RFC822", 1); if ($ok) { my @ret = map { $_->[1] } @$lines; return $wants_many ? \@ret : $ret[0]; } return undef; } sub get_part_body { my ($self, $msg, $part) = @_; $part = "BODY[$part]"; my ($ok, $lines) = $self->_tell_imap(FETCH => "$msg $part", 1); if ($ok) { # it can contain FLAGS notification, i.e. \Seen flag becomes set my $tokens = _parse_tokens($lines->[0], 1); my %hash = @{$tokens->[3]}; if ($hash{FLAGS}) { $self->_handle_notification($tokens); } return $hash{$part}; } return undef; } sub get_parts_bodies { my ($self, $msg, $parts) = @_; my $tmp = join(' ', map { "BODY[$_]" } @$parts); my ($ok, $lines) = $self->_tell_imap(FETCH => "$msg ($tmp)", 1); if ($ok) { # it can contain FLAGS notification, i.e. \Seen flag becomes set my $tokens = _parse_tokens($lines->[0], 1); my %hash = @{$tokens->[3]}; if ($hash{FLAGS}) { $self->_handle_notification($tokens); } my %ret = map {( $_, $hash{"BODY[$_]"} )} @$parts; return \%ret; } return undef; } sub get_summaries { my ($self, $msg, $headers) = @_; if (!$msg) { $msg = '1:*'; } elsif (ref $msg eq 'ARRAY') { $msg = join(',', @$msg); } if ($headers) { $headers = " BODY.PEEK[HEADER.FIELDS ($headers)]"; } else { $headers = ''; } my ($ok, $lp) = $self->_tell_imap(FETCH => qq[$msg (UID FLAGS INTERNALDATE RFC822.SIZE ENVELOPE BODYSTRUCTURE$headers)], 1); if ($ok) { my @ret; foreach (@$lp) { my $summary; my $tokens = _parse_tokens($_); ## in form: [ '*', ID, 'FETCH', [ tokens ]] if ($tokens->[2] eq 'FETCH') { my %hash = @{$tokens->[3]}; if ($hash{ENVELOPE}) { # full fetch $summary = Net::IMAP::Client::MsgSummary->new(\%hash, undef, !!$headers); $summary->{seq_id} = $tokens->[1]; } else { # 'FETCH' (probably FLAGS) notification! $self->_handle_notification($tokens); } } else { # notification! $self->_handle_notification($tokens); } push @ret, $summary if $summary; } return \@ret; } else { return undef; } } sub fetch { my ($self, $msg, $keys) = @_; my $wants_many = undef; if (ref $msg eq 'ARRAY') { $msg = join(',', @$msg); $wants_many = 1; } if (ref $keys eq 'ARRAY') { $keys = join(' ', @$keys); } my ($ok, $lp) = $self->_tell_imap(FETCH => qq[$msg ($keys)], 1); if ($ok) { my @ret; foreach (@$lp) { my $tokens = _parse_tokens($_)->[3]; push @ret, { @$tokens }; } return $wants_many || @ret > 1 ? \@ret : $ret[0]; } } sub create_folder { my ($self, $folder) = @_; my $quoted = $folder; _string_quote($quoted); my ($ok) = $self->_tell_imap(CREATE => $quoted); return $ok; } # recursively removes any subfolders! sub delete_folder { my ($self, $folder) = @_; my $quoted = $folder . $self->separator . '*'; _string_quote($quoted); my ($ok, $lines) = $self->_tell_imap(LIST => qq{"" $quoted}); if ($ok) { my @subfolders; foreach my $line (@$lines) { my $tokens = _parse_tokens($line); push @subfolders, $tokens->[4]; } @subfolders = sort { length($b) - length($a) } @subfolders; foreach (@subfolders) { _string_quote($_); ($ok) = $self->_tell_imap(DELETE => $_); } $quoted = $folder; _string_quote($quoted); ($ok) = $self->_tell_imap(DELETE => $quoted); } return $ok; } sub append { my ($self, $folder, $rfc822, $flags, $date) = @_; die 'message body passed to append() must be a SCALAR reference' unless ref $rfc822 eq 'SCALAR'; my $quoted = $folder; _string_quote($quoted); my $args = [ "$quoted " ]; if ($flags) { # my @tmp = @$flags; # $quoted = join(' ', map { _string_quote($_) } @tmp); # push @$args, "($quoted) "; push @$args, '(' . join(' ', @$flags) . ') '; } if ($date) { my $tmp = $date; _string_quote($tmp); push @$args, "$tmp "; } push @$args, $rfc822; my ($ok) = $self->_tell_imap(APPEND => $args, 1); return $ok; } sub copy { my ($self, $msg, $folder) = @_; my $quoted = $folder; _string_quote($quoted); if (ref $msg eq 'ARRAY') { $msg = join(',', @$msg); } my ($ok) = $self->_tell_imap(COPY => "$msg $quoted", 1); return $ok; } sub get_flags { my ($self, $msg) = @_; my $wants_many = undef; if (ref($msg) eq 'ARRAY') { $msg = join(',', @$msg); $wants_many = 1; } my ($ok, $lines) = $self->_tell_imap(FETCH => "$msg (UID FLAGS)", 1); if ($ok) { my %ret = map { my $tokens = _parse_tokens($_)->[3]; my %hash = @$tokens; $hash{UID} => $hash{FLAGS}; } @$lines; return $wants_many ? \%ret : $ret{$msg}; } return undef; } sub get_threads { my ($self, $algo, $msg) = @_; $algo ||= "REFERENCES"; my ($ok, $lines) = $self->_tell_imap(THREAD => "$algo UTF-8 ALL"); if ($ok) { my $result = $lines->[0][0]; $result =~ s/^\*\s+THREAD\s+//; my $parsed = _parse_tokens([ $result ]); if ($msg) { (my $left = $result) =~ s/\b$msg\b.*$//; my $thr = 0; my $par = 0; for (my $i = 0; $i < length($left); ++$i) { my $c = substr($left, $i, 1); if ($c eq '(') { $par++; } elsif ($c eq ')') { $par--; if ($par == 0) { $thr++; } } } $parsed = $parsed->[$thr]; } return $parsed; } return $ok; } sub _store_helper { my ($self, $msg, $flags, $cmd) = @_; if (ref $msg eq 'ARRAY') { $msg = join(',', @$msg); } unless (ref $flags) { $flags = [ $flags ]; } $flags = '(' . join(' ', @$flags) . ')'; $self->_tell_imap(STORE => "$msg $cmd $flags", 1); } sub store { my ($self, $msg, $flags) = @_; $self->_store_helper($msg, $flags, 'FLAGS'); } sub add_flags { my ($self, $msg, $flags) = @_; $self->_store_helper($msg, $flags, '+FLAGS'); } sub del_flags { my ($self, $msg, $flags) = @_; $self->_store_helper($msg, $flags, '-FLAGS'); } sub delete_message { my ($self, $msg) = @_; $self->add_flags($msg, '\\Deleted'); } sub expunge { my ($self) = @_; my ($ok, $lines) = $self->_tell_imap('EXPUNGE' => undef, 1); if ($ok && $lines && @$lines) { my $ret = $lines->[0][0]; if ($ret =~ /^\*\s+(\d+)\s+EXPUNGE/) { return $1 + 0; } } return $ok ? -1 : undef; } sub last_error { my ($self) = @_; $self->{_error} =~ s/\s+$//s; # remove trailing carriage return return $self->{_error}; } sub notifications { my ($self) = @_; my $tmp = $self->{notifications}; $self->{notifications} = []; return wantarray ? @$tmp : $tmp; } ##### internal stuff ##### sub _get_port { my ($self) = @_; return $self->{port} || ($self->{ssl} ? 993 : 143); } sub _get_timeout { my ($self) = @_; return $self->{timeout} || 90; } sub _get_server { my ($self) = @_; return $self->{server}; } sub _get_ssl_config { my ($self) = @_; if (!$self->{ssl_verify_peer} || !$self->{ssl_ca_path} && !$self->{ssl_ca_file} && $^O ne 'linux') { return SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_NONE; } my %ssl_config = ( SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_PEER ); if ($^O eq 'linux' && !$self->{ssl_ca_path} && !$self->{ssl_ca_file}) { $ssl_config{SSL_ca_path} = '/etc/ssl/certs/'; -d $ssl_config{SSL_ca_path} or die "$ssl_config{SSL_ca_path}: SSL certification directory not found"; } $ssl_config{SSL_ca_path} = $self->{ssl_ca_path} if $self->{ssl_ca_path}; $ssl_config{SSL_ca_file} = $self->{ssl_ca_file} if $self->{ssl_ca_file}; return %ssl_config; } sub _get_socket { my ($self) = @_; my $socket = $self->{socket} ||= ($self->{ssl} ? 'IO::Socket::SSL' : 'IO::Socket::INET')->new( ( ( %{$self->{ssl_options}} ) x !!$self->{ssl} ), PeerAddr => $self->_get_server, PeerPort => $self->_get_port, Timeout => $self->_get_timeout, Proto => 'tcp', Blocking => 1, $self->_get_ssl_config, ) or die "failed connect or ssl handshake: $!,$IO::Socket::SSL::SSL_ERROR"; $socket->sockopt(SO_KEEPALIVE, 1); return $socket; } sub _get_next_id { return ++$_[0]->{_cmd_id}; } sub _socket_getline { local $/ = "\r\n"; return $_[0]->_get_socket->getline; } sub _socket_write { my $self = shift; # open LOG, '>>:raw', '/tmp/net-imap-client.log'; # print LOG @_; # close LOG; $self->_get_socket->write(@_); } sub _send_cmd { my ($self, $cmd, $args) = @_; local $\; use bytes; my $id = $self->_get_next_id; if ($self->uid_mode && exists($UID_COMMANDS{$cmd})) { $cmd = "UID $cmd"; } my @literals = (); if (ref $args eq 'ARRAY') { # may contain literals foreach (@$args) { if (ref $_ eq 'SCALAR') { push @literals, $_; $_ = '{' . length($$_) . "}\r\n"; } } $args = join('', @$args); } my $socket = $self->_get_socket; if (@literals == 0) { $cmd = "NIC$id $cmd" . ($args ? " $args" : '') . "\r\n"; $self->_socket_write($cmd); } else { $cmd = "NIC$id $cmd "; $self->_socket_write($cmd); my @split = split(/\r\n/, $args); my $ea = each_array(@split, @literals); while (my ($tmp, $lit) = $ea->()) { $self->_socket_write($tmp . "\r\n"); my $line = $self->_socket_getline; # print STDERR "$line - $tmp\n"; if ($line =~ /^\+/) { $self->_socket_write($$lit); } else { $self->{_error} = "Expected continuation, got: $line"; # XXX: it's really bad if we get here, what to do? return undef; } } $self->_socket_write("\r\n"); # end of command! } $socket->flush; return "NIC$id"; } sub _read_literal { my ($self, $count) = @_; my $buf; my @lines = (); my $sock = $self->_get_socket; # print STDERR "\033[1;31m ::: Reading $count bytes ::: \033[0m \n"; while ($count > 0) { my $read = $sock->read($buf, min($count, $READ_BUFFER)); # print STDERR "GOT $read / $buf"; $count -= $read; last if !$read; push @lines, $buf; } $buf = join('', @lines); return \$buf; } sub _cmd_ok { my ($self, $res, $id) = @_; $id ||= $self->{_cmd_id}; if ($res =~ /^NIC$id\s+OK/i) { return 1; } elsif ($res =~ /^NIC$id\s+(?:NO|BAD)(?:\s+(.+))?/i) { my $error = $1 || 'unknown error'; $self->{_error} = $error; return 0; } return undef; } sub _cmd_ok2 { my ($self, $res) = @_; if ($res =~ /^(NIC\d+)\s+OK/i) { my $id = $1; return ($id, 1); } elsif ($res =~ /^(NIC\d+)\s+(?:NO|BAD)(?:\s+(.+))?/i) { my $id = $1; my $error = $2 || 'unknown error'; $self->{_error} = $error; return ($id, 0, $error); } return (); } sub _reconnect_if_needed { my ($self, $force) = @_; if ($force || !$self->_get_socket->connected) { $self->{socket} = undef; $self->{greeting} = $self->_socket_getline; if ($self->login) { if ($self->{selected_folder}) { $self->select($self->{selected_folder}); } return 1; } return undef; } return 0; } sub _tell_imap { my ($self, $cmd, $args, $do_notf) = @_; $cmd = uc $cmd; my ($lineparts, $ok, $res); RETRY1: { $self->_send_cmd($cmd, $args); redo RETRY1 if $self->_reconnect_if_needed; } $lineparts = []; # holds results in boxes my $accumulator = []; # box for collecting results while ($res = $self->_socket_getline) { # print STDERR ">>>>$res<<<<<\n"; if ($res =~ /^\*/) { # store previous box and start a new one push @$lineparts, $accumulator if @$accumulator; $accumulator = []; } if ($res =~ /(.*)\{(\d+)\}\r\n/) { my ($line, $len) = ($1, $2 + 0); push @$accumulator, $line, $self->_read_literal($len); } else { $ok = $self->_cmd_ok($res); if (defined($ok)) { last; } else { push @$accumulator, $res; } } } # store last box push @$lineparts, $accumulator if @$accumulator; unless (defined $res) { goto RETRY1 if $self->_reconnect_if_needed(1); } if ($do_notf) { no warnings 'uninitialized'; for (my $i = scalar(@$lineparts); --$i >= 0;) { my $line = $lineparts->[$i]; # 1. notifications don't contain literals last if scalar(@$line) != 1; my $text = $line->[0]; # 2. FETCH notifications only contain FLAGS. We make a # promise never to FETCH flags alone intentionally. # 3. Other notifications will have a first token different # from the running command if ( $text =~ /^\*\s+\d+\s+FETCH\s*\(\s*FLAGS\s*\([^\)]*?\)\)/ || $text !~ /^\*\s+(?:\d+\s+)?$cmd/ ) { my $tokens = _parse_tokens($line); if ($self->_handle_notification($tokens, 1)) { splice @$lineparts, $i, 1; } next; } last; } } return wantarray ? ($ok, $lineparts) : $ok ? $lineparts : undef; } # Variant of the above method that sends multiple commands. After # sending all commands to the server, it waits until all results are # returned and puts them in an array, in the order the commands were # sent. sub _tell_imap2 { my ($self, @cmd) = @_; my %results; my @ids; RETRY2: { @ids = (); foreach (@cmd) { push @ids, $self->_send_cmd($_); redo RETRY2 if $self->_reconnect_if_needed; } } %results = (); for (0..$#cmd) { my $lineparts = []; my $accumulator = []; my $res; while ($res = $self->_socket_getline) { # print STDERR "2: $res"; if ($res =~ /^\*/) { push @$lineparts, $accumulator if @$accumulator; $accumulator = []; } if ($res =~ /(.*)\{(\d+)\}\r\n/) { my ($line, $len) = ($1, $2); push @$accumulator, $line, $self->_read_literal($len); } else { my ($cmdid, $ok, $error) = $self->_cmd_ok2($res); if (defined($ok)) { $results{$cmdid} = [ $ok, $lineparts, $error ]; last; } else { push @$accumulator, $res; } } } push @$lineparts, $accumulator if @$accumulator; unless (defined $res) { goto RETRY2 if $self->_reconnect_if_needed(1); } } my @ret = @results{@ids}; return \@ret; } sub _string_quote { $_[0] =~ s/\\/\\\\/g; $_[0] =~ s/\"/\\\"/g; $_[0] = "\"$_[0]\""; } sub _string_unquote { if ($_[0] =~ s/^"//g) { $_[0] =~ s/"$//g; $_[0] =~ s/\\\"/\"/g; $_[0] =~ s/\\\\/\\/g; } } ##### parse imap response ##### # # This is probably the simplest/dumbest way to parse the IMAP output. # Nevertheless it seems to be very stable and fast. # # $input is an array ref containing IMAP output. Normally it will # contain only one entry -- a line of text -- but when IMAP sends # literal data, we read it separately (see _read_literal) and store it # as a scalar reference, therefore it can be like this: # # [ '* 11 FETCH (RFC822.TEXT ', \$DATA, ')' ] # # so that's why the routine looks a bit more complicated. # # It returns an array of tokens. Literal strings are dereferenced so # for the above text, the output will be: # # [ '*', '11', 'FETCH', [ 'RFC822.TEXT', $DATA ] ] # # note that lists are represented as arrays. # sub _parse_tokens { my ($input, $no_deref) = @_; my @tokens = (); my @stack = (\@tokens); while (my $text = shift @$input) { if (ref $text) { push @{$stack[-1]}, ($no_deref ? $text : $$text); next; } while (1) { $text =~ m/\G\s+/gc; if ($text =~ m/\G[([]/gc) { my $sub = []; push @{$stack[-1]}, $sub; push @stack, $sub; } elsif ($text =~ m/\G(BODY\[[a-zA-Z0-9._() -]*\])/gc) { push @{$stack[-1]}, $1; # let's consider this an atom too } elsif ($text =~ m/\G[])]/gc) { pop @stack; } elsif ($text =~ m/\G\"((?:\\.|[^\"\\])*)\"/gc) { my $str = $1; # unescape $str =~ s/\\\"/\"/g; $str =~ s/\\\\/\\/g; push @{$stack[-1]}, $str; # found string } elsif ($text =~ m/\G(\d+)/gc) { push @{$stack[-1]}, $1 + 0; # found numeric } elsif ($text =~ m/\G([a-zA-Z0-9_\$\\.+\/*&-]+)/gc) { my $atom = $1; if (lc $atom eq 'nil') { $atom = undef; } push @{$stack[-1]}, $atom; # found atom } else { last; } } } return \@tokens; } sub _handle_notification { my ($self, $tokens, $reverse) = @_; no warnings 'uninitialized'; my $not; my $sf = $self->{selected_folder}; if ($sf) { # otherwise we shouldn't get any notifications, but whatever $sf = $self->{FOLDERS}{$sf}; if ($tokens->[2] eq 'FETCH') { my %data = @{$tokens->[3]}; if (my $flags = $data{FLAGS}) { $not = { seq => $tokens->[1] + 0, flags => $flags }; if (first { $_ eq '\\Deleted' } @$flags) { --$sf->{messages}; $not->{deleted} = 1; } if ($data{UID}) { $not->{uid} = $data{UID}; } } } elsif ($tokens->[2] eq 'EXISTS') { $sf->{messages} = $tokens->[1] + 0; $not = { messages => $tokens->[1] + 0 }; } elsif ($tokens->[2] eq 'EXPUNGE') { --$sf->{messages}; $not = { seq => $tokens->[1] + 0, destroyed => 1 }; } elsif ($tokens->[2] eq 'RECENT') { $sf->{recent} = $tokens->[1] + 0; $not = { recent => $tokens->[1] + 0 }; } elsif ($tokens->[1] eq 'FLAGS') { $sf->{flags} = $tokens->[2]; $not = { flags => $tokens->[2] }; } elsif ($tokens->[1] eq 'OK') { $sf->{sflags}{$tokens->[2][0]} = $tokens->[2][1]; } } if (defined $not) { $not->{folder} = $self->{selected_folder}; if ($reverse) { unshift @{$self->{notifications}}, $not; } else { push @{$self->{notifications}}, $not; } return 1; } return 0; } 1; __END__ =pod =encoding utf8 =head1 NAME Net::IMAP::Client - Not so simple IMAP client library =head1 SYNOPSIS use Net::IMAP::Client; my $imap = Net::IMAP::Client->new( server => 'mail.you.com', user => 'USERID', pass => 'PASSWORD', ssl => 1, # (use SSL? default no) ssl_verify_peer => 1, # (use ca to verify server, default yes) ssl_ca_file => '/etc/ssl/certs/certa.pm', # (CA file used for verify server) or # ssl_ca_path => '/etc/ssl/certs/', # (CA path used for SSL) port => 993 # (but defaults are sane) ) or die "Could not connect to IMAP server"; # everything's useless if you can't login $imap->login or die('Login failed: ' . $imap->last_error); # let's see what this server knows (result cached on first call) my $capab = $imap->capability; # or my $knows_sort = $imap->capability( qr/^sort/i ); # get list of folders my @folders = $imap->folders; # get total # of messages, # of unseen messages etc. (fast!) my $status = $imap->status(@folders); # hash ref! # select folder $imap->select('INBOX'); # get folder hierarchy separator (cached at first call) my $sep = $imap->separator; # fetch all message ids (as array reference) my $messages = $imap->search('ALL'); # fetch all ID-s sorted by subject my $messages = $imap->search('ALL', 'SUBJECT'); # or my $messages = $imap->search('ALL', [ 'SUBJECT' ]); # fetch ID-s that match criteria, sorted by subject and reverse date my $messages = $imap->search({ FROM => 'foo', SUBJECT => 'bar', }, [ 'SUBJECT', '^DATE' ]); # fetch message summaries (actually, a lot more) my $summaries = $imap->get_summaries([ @msg_ids ]); foreach (@$summaries) { print $_->uid, $_->subject, $_->date, $_->rfc822_size; print join(', ', @{$_->from}); # etc. } # fetch full message my $data = $imap->get_rfc822_body($msg_id); print $$data; # it's reference to a scalar # fetch full messages my @msgs = $imap->get_rfc822_body([ @msg_ids ]); print $$_ for (@msgs); # fetch single attachment (message part) my $data = $imap->get_part_body($msg_id, '1.2'); # fetch multiple attachments at once my $hash = $imap->get_parts_bodies($msg_id, [ '1.2', '1.3', '2.2' ]); my $part1_2 = $hash->{'1.2'}; my $part1_3 = $hash->{'1.3'}; my $part2_2 = $hash->{'2.2'}; print $$part1_2; # need to dereference it # copy messages between folders $imap->select('INBOX'); $imap->copy(\@msg_ids, 'Archive'); # delete messages ("Move to Trash") $imap->copy(\@msg_ids, 'Trash'); $imap->add_flags(\@msg_ids, '\\Deleted'); $imap->expunge; =head1 DESCRIPTION Net::IMAP::Client provides methods to access an IMAP server. It aims to provide a simple and clean API, while employing a rigorous parser for IMAP responses in order to create Perl data structures from them. The code is simple, clean and extensible. It started as an effort to improve L but then I realized that I needed to change a lot of code and API so I started it as a fresh module. Still, the design is influenced by Net::IMAP::Simple and I even stole a few lines of code from it ;-) (very few, honestly). This software was developed for creating a web-based email (IMAP) client: www.xuheki.com. Xhueki uses Net::IMAP::Client. =head1 API REFERENCE Unless otherwise specified, if a method fails it returns I and you can inspect the error by calling $imap->last_error. For a successful call most methods will return a meaningful value but definitely not I. =head2 new(%args) # constructor my $imap = Net::IMAP::Client->new(%args); Pass to the constructor a hash of arguments that can contain: =over =item - B (STRING) Host name or IP of the IMAP server. =item - B (STRING) User ID (I) =item - B (STRING) Password =item - B (BOOL, optional, default FALSE) Pass a true value if you want to use IO::Socket::SSL =item - B (BOOL, optional, default TRUE) Pass a false value if you do not want to use SSL CA to verify server only need when you set ssl to true =item - B (STRING, optional) Pass a file path which used as CA file to verify server at least one of ssl_ca_file and ssl_ca_path is needed for ssl verify server =item -B (STRING, optional) Pass a dir which will be used as CA file search dir, found CA file will be used to verify server On linux, by default is '/etc/ssl/certs/' at least one of ssl_ca_file and ssl_ca_path is needed for ssl verify server =item - B (HASHREF, optional) Optional arguments to be passed to the L object. =item - B (BOOL, optional, default TRUE) Whether to use UID command (see RFC3501). Recommended. =item - B (IO::Handle, optional) If you already have a socket connected to the IMAP server, you can pass it here. =back The B and B only need when you set B to TRUE. If you havn't apply an B and B, on linux, the B will use the value '/etc/ssl/certs/', on other platform B will be disabled. The constructor doesn't login to the IMAP server -- you need to call $imap->login for that. =head2 last_error Returns the last error from the IMAP server. =head2 login($user, $pass) Login to the IMAP server. You can pass $user and $pass here if you wish; if not passed, the values used in constructor will be used. Returns I if login failed. =head2 logout / quit Send EXPUNGE and LOGOUT then close connection. C is an alias for C. =head2 noop "Do nothing" method that calls the IMAP "NOOP" command. It returns a true value upon success, I otherwise. This method fetches any notifications that the server might have for us and you can get them by calling $imap->notifications. See the L method. =head2 capability() / capability(qr/^SOMETHING/) With no arguments, returns an array of all capabilities advertised by the server. If you're interested in a certain capability you can pass a RegExp. E.g. to check if this server knows 'SORT', you can do this: if ($imap->capability(/^sort$/i)) { # speaks it } This data is cached, the server will be only hit once. =head2 select($folder) Selects the current IMAP folder. On success this method also records some information about the selected folder in a hash stored in $self->{FOLDERS}{$folder}. You might want to use Data::Dumper to find out exactly what, but at the time of this writing this is: =over =item - B Total number of messages in this folder =item - B Flags available for this folder (as array ref) =item - B Total number of recent messages in this folder =item - B Various other flags here, such as PERMANENTFLAGS of UIDVALIDITY. You might want to take a look at RFC3501 at this point. :-p =back This method is basically stolen from Net::IMAP::Simple. =head2 examine($folder) Selects the current IMAP folder in read-only (EXAMINE) mode. Otherwise identical to select. =head2 status($folder), status(\@folders) Returns the status of the given folder(s). If passed an array ref, the return value is a hash ref mapping folder name to folder status (which are hash references in turn). If passed a single folder name, it returns the status of that folder only. my $inbox = $imap->status('INBOX'); print $inbox->{UNSEEN}, $inbox->{MESSAGES}; print Data::Dumper::Dumper($inbox); my $all = $imap->status($imap->folders); while (my ($name, $status) = each %$all) { print "$name : $status->{MESSAGES}/$status->{UNSEEN}\n"; } This method is designed to be very fast when passed multiple folders. It's I faster to call: $imap->status(\@folders); than: $imap->status($_) foreach (@folders); because it sends all the STATUS requests to the IMAP server before it starts receiving the answers. In my tests with my remote IMAP server, for 40 folders this method takes 0.6 seconds, compared to 6+ seconds when called individually for each folder alone. =head2 separator Returns the folder hierarchy separator. This is provided as a result of the following IMAP command: FETCH "" "*" I don't know of any way to change this value on a server so I have to assume it's a constant. Therefore, this method caches the result and it won't hit the server a second time on subsequent calls. =head2 folders Returns a list of all folders available on the server. In scalar context it returns a reference to an array, i.e.: my @a = $imap->folders; my $b = $imap->folders; # now @a == @$b; =head2 folders_more Returns an hash reference containing more information about folders. It maps folder name to an hash ref containing the following: - flags -- folder flags (array ref; i.e. [ '\\HasChildren' ]) - sep -- one character containing folder hierarchy separator - name -- folder name (same as the key -- thus redundant) =head2 namespace Returns an hash reference containing the namespaces for this server (see RFC 2342). Since the RFC defines 3 possible types of namespaces, the hash contains the following keys: - `personal' -- the personal namespace - `other' -- "other users" namespace - `shared' -- shared namespace Each one can be I if the server returned "NIL", or an array reference. If an array reference, each element is in the form: { sep => '.', prefix => 'INBOX.' } (I is the separator for this hierarchy, and I is the prefix). =head2 seq_to_uid(@sequence_ids) I recommend usage of UID-s only (see L) but this isn't always possible. Even when C is on, the server will sometimes return notifications that only contain message sequence numbers. To convert these to UID-s you can use this method. On success it returns an hash reference which maps sequence numbers to message UID-s. Of course, on failure it returns I. =head2 search($criteria, $sort, $charset) Executes the "SEARCH" or "SORT" IMAP commands (depending on wether $sort is I) and returns the results as an array reference containing message ID-s. Note that if you use C<$sort> and the IMAP server doesn't have this capability, this method will fail. Use L to investigate. =over =item - B<$criteria> Can be a string, in which case it is passed literally to the IMAP command (which can be "SEARCH" or "SORT"). It can also be an hash reference, in which case keys => values are collected into a string and values are properly quoted, i.e.: { subject => 'foo', from => 'bar' } will translate to: 'SUBJECT "foo" FROM "bar"' which is a valid IMAP SEARCH query. If you want to retrieve all messages (no search criteria) then pass 'ALL' here. =item - B<$sort> Can be a string or an array reference. If it's an array, it will simply be joined with a space, so for instance passing the following is equivalent: 'SUBJECT DATE' [ 'SUBJECT', 'DATE' ] The SORT command in IMAP allows you to prefix a sort criteria with 'REVERSE' which would mean descending sorting; this module will allow you to prefix it with '^', so again, here are some equivalent constructs: 'SUBJECT REVERSE DATE' 'SUBJECT ^DATE' [ 'SUBJECT', 'REVERSE', 'DATE' ] [ 'subject', 'reverse date' ] [ 'SUBJECT', '^DATE' ] It'll also uppercase whatever you passed here. If you omit $sort (or pass I) then this method will use the SEARCH command. Otherwise it uses the SORT command. =item - B<$charset> The IMAP SORT recommendation [2] requires a charset declaration for SORT, but not for SEARCH. Interesting, huh? Our module is a bit more paranoid and it will actually add charset for both SORT and SEARCH. If $charset is omitted (or I) the it will default to "UTF-8", which, supposedly, is supported by all IMAP servers. =back =head2 get_rfc822_body($msg_id) Fetch and return the full RFC822 body of the message. B<$msg_id> can be a scalar but also an array of ID-s. If it's an array, then all bodies of those messages will be fetched and the return value will be a list or an array reference (depending how you call it). Note that the actual data is returned as a reference to a scalar, to speed things up. Examples: my $data = $imap->get_rfc822_body(10); print $$data; # need to dereference it my @more = $imap->get_rfc822_body([ 11, 12, 13 ]); print $$_ foreach @more; or my $more = $imap->get_rfc822_body([ 11, 12, 13 ]); print $$_ foreach @$more; =head2 get_part_body($msg_id, $part_id) Fetches and returns the body of a certain part of the message. Part ID-s look like '1' or '1.1' or '2.3.1' etc. (see RFC3501 [1], "FETCH Command"). =head3 Scalar reference Note that again, this data is returned as a reference to a scalar rather than the scalar itself. This decision was taken purely to save some time passing around potentially large data from Perl subroutines. =head3 Undecoded One other thing to note is that the data is not decoded. One simple way to decode it is use Email::MIME::Encodings, i.e.: use Email::MIME::Encodings; my $summary = $imap->get_summaries(10)->[0]; my $part = $summary->get_subpart('1.1'); my $body = $imap->get_part_body('1.1'); my $cte = $part->transfer_encoding; # Content-Transfer-Encoding $body = Email::MIME::Encodings::decode($cte, $$body); # and now you should have the undecoded (perhaps binary) data. See get_summaries below. =head2 get_parts_bodies($msg_id, \@part_ids) Similar to get_part_body, but this method is capable to retrieve more parts at once. It's of course faster than calling get_part_body for each part alone. Returns an hash reference which maps part ID to part body (the latter is a reference to a scalar containing the actual data). Again, the data is not unencoded. my $parts = $imap->get_parts_bodies(10, [ '1.1', '1.2', '2.1' ]); print ${$parts->{'1.1'}}; =head2 get_summaries($msg, $headers) / get_summaries(\@msgs, $headers) (C<$headers> is optional). Fetches, parses and returns "message summaries". $msg can be an array ref, or a single id. The return value is always an array reference, even if a single message is queried. If $headers is passed, it must be a string containing name(s) of the header fields to fetch (space separated). Example: $imap->get_summaries([1, 2, 3], 'References X-Original-To') The result contains L objects. The best way to understand the result is to actually call this function and use Data::Dumper to see its structure. Following is the output for a pretty complicated message, which contains an HTML part with an embedded image and an attached message. The attached message in turn contains an HTML part and an embedded message. bless( { 'message_id' => '<48A71D17.1000109@foobar.com>', 'date' => 'Sat, 16 Aug 2008 21:31:51 +0300', 'to' => [ bless( { 'at_domain_list' => undef, 'name' => undef, 'mailbox' => 'kwlookup', 'host' => 'foobar.com' }, 'Net::IMAP::Client::MsgAddress' ) ], 'cc' => undef, 'from' => [ bless( { 'at_domain_list' => undef, 'name' => 'Mihai Bazon', 'mailbox' => 'justme', 'host' => 'foobar.com' }, 'Net::IMAP::Client::MsgAddress' ) ], 'flags' => [ '\\Seen', 'NonJunk', 'foo_bara' ], 'uid' => '11', 'subject' => 'test with message attachment', 'rfc822_size' => '12550', 'in_reply_to' => undef, 'bcc' => undef, 'internaldate' => '16-Aug-2008 21:29:23 +0300', 'reply_to' => [ bless( { 'at_domain_list' => undef, 'name' => 'Mihai Bazon', 'mailbox' => 'justme', 'host' => 'foobar.com' }, 'Net::IMAP::Client::MsgAddress' ) ], 'sender' => [ bless( { 'at_domain_list' => undef, 'name' => 'Mihai Bazon', 'mailbox' => 'justme', 'host' => 'foobar.com' }, 'Net::IMAP::Client::MsgAddress' ) ], 'parts' => [ bless( { 'part_id' => '1', 'parts' => [ bless( { 'parameters' => { 'charset' => 'UTF-8' }, 'subtype' => 'html', 'part_id' => '1.1', 'encoded_size' => '365', 'cid' => undef, 'type' => 'text', 'description' => undef, 'transfer_encoding' => '7bit' }, 'Net::IMAP::Client::MsgSummary' ), bless( { 'disposition' => { 'inline' => { 'filename' => 'someimage.png' } }, 'language' => undef, 'encoded_size' => '4168', 'description' => undef, 'transfer_encoding' => 'base64', 'parameters' => { 'name' => 'someimage.png' }, 'subtype' => 'png', 'part_id' => '1.2', 'type' => 'image', 'cid' => '', 'md5' => undef }, 'Net::IMAP::Client::MsgSummary' ) ], 'multipart_type' => 'related' }, 'Net::IMAP::Client::MsgSummary' ), bless( { 'message_id' => '<48A530CE.3050807@foobar.com>', 'date' => 'Fri, 15 Aug 2008 10:31:26 +0300', 'encoded_size' => '6283', 'to' => [ bless( { 'at_domain_list' => undef, 'name' => undef, 'mailbox' => 'kwlookup', 'host' => 'foobar.com' }, 'Net::IMAP::Client::MsgAddress' ) ], 'subtype' => 'rfc822', 'cc' => undef, 'from' => [ bless( { 'at_domain_list' => undef, 'name' => 'Mihai Bazon', 'mailbox' => 'justme', 'host' => 'foobar.com' }, 'Net::IMAP::Client::MsgAddress' ) ], 'subject' => 'Test with images', 'in_reply_to' => undef, 'description' => undef, 'transfer_encoding' => '7bit', 'parameters' => { 'name' => 'Attached Message' }, 'bcc' => undef, 'part_id' => '2', 'sender' => [ bless( { 'at_domain_list' => undef, 'name' => 'Mihai Bazon', 'mailbox' => 'justme', 'host' => 'foobar.com' }, 'Net::IMAP::Client::MsgAddress' ) ], 'reply_to' => [ bless( { 'at_domain_list' => undef, 'name' => 'Mihai Bazon', 'mailbox' => 'justme', 'host' => 'foobar.com' }, 'Net::IMAP::Client::MsgAddress' ) ], 'parts' => [ bless( { 'parameters' => { 'charset' => 'UTF-8' }, 'subtype' => 'html', 'part_id' => '2.1', 'encoded_size' => '344', 'cid' => undef, 'type' => 'text', 'description' => undef, 'transfer_encoding' => '7bit' }, 'Net::IMAP::Client::MsgSummary' ), bless( { 'disposition' => { 'inline' => { 'filename' => 'logo.png' } }, 'language' => undef, 'encoded_size' => '4578', 'description' => undef, 'transfer_encoding' => 'base64', 'parameters' => { 'name' => 'logo.png' }, 'subtype' => 'png', 'part_id' => '2.2', 'type' => 'image', 'cid' => '', 'md5' => undef }, 'Net::IMAP::Client::MsgSummary' ) ], 'cid' => undef, 'type' => 'message', 'multipart_type' => 'related' }, 'Net::IMAP::Client::MsgSummary' ) ], 'multipart_type' => 'mixed' }, 'Net::IMAP::Client::MsgSummary' ); As you can see, the parser retrieves all data, including from the embedded messages. There are many other modules you can use to fetch such information. L and L are great. The only problem is that you have to have fetched already the full (RFC822) body of the message, which is impractical over IMAP. When you want to quickly display a folder summary, the only practical way is to issue a FETCH command and retrieve only those headers that you are interested in (instead of full body). C does exactly that (issues a FETCH (FLAGS INTERNALDATE RFC822.SIZE ENVELOPE BODYSTRUCTURE)). It's acceptably fast even for huge folders. =head2 fetch($msg_id, $attributes) This is a low level interface to FETCH. It calls the imap FETCH command and returns a somewhat parsed hash of the results. C<$msg_id> can be a single message ID or an array of IDs. If a single ID is given, the return value will be a hash reference containing the requested values. If C<$msg_id> is an array, even if it contains a single it, then the return value will be an array of hashes. C<$attributes> is a string of attributes to FETCH, separated with a space, or an array (ref) of attributes. Examples: # retrieve the UID of the most recent message my $last_uid = $imap->fetch('*', 'UID')->{UID}; # fetch the flags of the first message my $flags = $imap->fetch(1, 'FLAGS')->{FLAGS}; # fetch flags and some headers (Subject and From) my $headers = 'BODY[HEADER.FIELDS (Subject From)]'; my $results = $imap->fetch([1, 2, 3], "FLAGS $headers"); foreach my $hash (@$results) { print join(" ", @{$hash->{FLAGS}}), "\n"; print $hash->{$headers}, "\n"; } =head2 notifications() The IMAP server may send various notifications upon execution of commands. They are collected in an array which is returned by this method (returns an array ref in scalar context, or a list otherwise). It clears the notifications queue so on second call it will return an empty array (unless new notifications were collected in the meantime). Each element in this array (notification) is a hash reference containing one or more or the following: - seq : the *sequence number* of the changed message - uid : UID of the changed message (NOT ALWAYS available!) - flags : new flags for this message - deleted : when the \Deleted flag was set for this message - messages : new number of messages in this folder - recent : number of recent messages in this folder - flags : new flags of this folder (seq is missing) - destroyed : when this message was expunged - folder : the name of the selected folder C is always present. C is present when a message was changed some flags (in which case you have C) or was expunged (in which case C is true). When C were changed and the B<\Deleted> flag is present, you also get C true. C is a message sequence number. Pretty dumb, I think it's preferable to work with UID-s, but that's what the IMAP server reports. In some cases the UID I be readily available (i.e. my IMAP server sends notifications in the same body as a response to, say, a FETCH BODY command), but when it's not, you have to rely on seq_to_uid(). B that when C is true, the message has been B; there is no way in this case to retrieve the UID so you have to rely solely on C in order to update your caches. When C is present but no C, it means that the list of available flags for the C has changed. You get C upon an "EXISTS" notification, which usually means "you have new mail". It indicates the total number of messages in the folder, not just "new" messages. I've yet to come up with a good way to measure the number of new/unseen messages, other than calling C. I rarely got C from my IMAP server in my tests; if more clients are simultaneously logged in as the same IMAP user, only one of them will receive "RECENT" notifications; others will have to rely on "EXISTS" to tell when new messages have arrived. Therefore I can only say that "RECENT" is useless and I advise you to ignore it. =head2 append($folder, \$rfc822, $flags, $date) Appends a message to the given C<$folder>. You must pass the full RFC822 body in C<$rfc822>. C<$flags> and C<$date> are optional. If you pass C<$flags>, it must be an array of strings specifying the initial flags of the appended message. If I, the message will be appended with an empty flag set, which amongst other things means that it will be regarded as an C<\Unseen> message. C<$date> specifies the INTERNALDATE of the appended messge. If I it will default to the current date/time. B this functionality is not tested; C<$date> should be in a format understood by IMAP. =head2 get_flags($msg_id) / get_flags(\@msg_ids) Returns the flags of one or more messages. The return value is an array (reference) if one message ID was passed, or a hash reference if an array (of one or more) message ID-s was passed. When an array was passed, the returned hash will map each message UID to an array of flags. =head2 store($msg, $flag) / store(\@msgs, \@flags) Resets FLAGS of the given message(s) to the given flag(s). C<$msg> can be an array of ID-s (or UID-s), or a single (U)ID. C<$flags> can be a single string, or an array reference as well. Note that the folder where these messages reside must have been already selected. Examples: $imap->store(10, '\\Seen'); $imap->store([11, 12], '\\Deleted'); $imap->store(13, [ '\\Seen', '\\Answered' ]); The IMAP specification defines certain reserved flags (they all start with a backslash). For example, a message with the flag C<\Deleted> should be regarded as deleted and will be permanently discarded by an EXPUNGE command. Although, it is possible to "undelete" a message by removing this flag. The following reserved flags are defined by the IMAP spec: \Seen \Answered \Flagged \Deleted \Draft \Recent The C<\Recent> flag is considered "read-only" -- you cannot add or remove it manually; the server itself will do this as appropriate. =head2 add_flags($msg, $flag) / add_flags(\@msgs, \@flags) Like store() but it doesn't reset all flags -- it just specifies which flags to B to the message. =head2 del_flags($msg, $flag) / del_flags(\@msgs, \@flags) Like store() / add_flags() but it B flags. =head2 delete_message($msg) / delete_message(\@msgs) Stores the \Deleted flag on the given message(s). Equivalent to: $imap->add_flags(\@msgs, '\\Deleted'); =head2 expunge() Permanently removes messages that have the C<\Deleted> flag set from the current folder. =head2 copy($msg, $folder) / copy(\@msg_ids, $folder) Copies message(s) from the selected folder to the given C<$folder>. You can pass a single message ID, or an array of message ID-s. =head2 create_folder($folder) Creates the folder with the given name. =head2 delete_folder($folder) Deletes the folder with the given name. This works a bit different from the IMAP specs. The IMAP specs says that any subfolders should remain intact. This method actually deletes subfolders recursively. Most of the time, this is What You Want. Note that all messages in C<$folder>, as well as in any subfolders, are permanently lost. =head2 get_threads($algorithm, $msg_id) Returns a "threaded view" of the current folder. Both arguments are optional. C<$algorithm> should be I, "REFERENCES" or "SUBJECT". If undefined, "REFERENCES" is assumed. This selects the threading algorithm, as per IMAP THREAD AND SORT extensions specification. I only tested "REFERENCES". C<$msg_id> can be undefined, or a message ID. If it's undefined, then a threaded view of the whole folder will be returned. If you pass a message ID, then this method will return the top-level thread that contains the message. The return value is an array which actually represents threads. Elements of this array are message ID-s, or other arrays (which in turn contain message ID-s or other arrays, etc.). The first element in an array will represent the start of the thread. Subsequent elements are child messages or subthreads. An example should help (FIXME). =head1 TODO =over =item - authentication schemes other than plain text (B) =item - better error handling? =back =head1 SEE ALSO L, L, L L, L RFC3501 [1] is a must read if you want to do anything fancier than what this module already supports. =head1 REFERENCES [1] http://ietfreport.isoc.org/rfc/rfc3501.txt [2] http://ietfreport.isoc.org/all-ids/draft-ietf-imapext-sort-20.txt =head1 AUTHOR Mihai Bazon, http://www.xuheki.com/ http://www.dynarchlib.com/ http://www.bazon.net/mishoo/ =head1 COPYRIGHT Copyright (c) Mihai Bazon 2008. All rights reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTY BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR, OR CORRECTION. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. =cut Net-IMAP-Client-0.9505/lib/Net/IMAP/Client/0000755000175000017500000000000012362255466016613 5ustar jrothjrothNet-IMAP-Client-0.9505/lib/Net/IMAP/Client/MsgSummary.pm0000644000175000017500000003561111504107360021245 0ustar jrothjrothpackage Net::IMAP::Client::MsgSummary; use Encode (); use Net::IMAP::Client::MsgAddress (); sub new { my ($class, $data, $part_id, $has_headers) = @_; bless my $self = {}, $class; if ($part_id) { $self->{part_id} = $part_id; } my $tmp = $data->{BODY}; if ($tmp) { $self->_parse_body($tmp); } $tmp = $data->{BODYSTRUCTURE}; if ($tmp) { $self->_parse_bodystructure($tmp); } $tmp = $data->{ENVELOPE}; if ($tmp) { $self->_parse_envelope($tmp); } $self->{flags} = $data->{FLAGS}; $self->{internaldate} = $data->{INTERNALDATE}; $self->{rfc822_size} = $data->{'RFC822.SIZE'}; $self->{uid} = $data->{UID}; if ($has_headers) { while (my ($key, $val) = each %$data) { if ($key =~ /^body(?:\.peek)?\s*\[\s*header\.fields/i) { $self->{headers} = $val; last; } } } return $self; } sub _decode { my ($str) = @_; if (defined($str)) { eval { $str = Encode::decode('MIME-Header', $str); }; } return $str; } sub type { $_[0]->{type} } sub subtype { $_[0]->{subtype} } sub parameters { $_[0]->{parameters} } sub cid { $_[0]->{cid} } sub description { _decode($_[0]->{description}) } sub transfer_encoding { $_[0]->{transfer_encoding} } sub encoded_size { $_[0]->{encoded_size} } sub content_type { my ($self) = @_; if ($self->type) { return $self->type . '/' . $self->subtype; } if ($self->multipart) { return 'multipart/' . $self->multipart; } return undef; } sub charset { $_[0]->{parameters}->{charset} } sub filename { my ($self) = @_; my $disp = $self->{disposition}; my $filename; if ($disp) { while (my ($key, $val) = each %$disp) { if (ref($val) eq 'HASH') { $filename = $val->{filename}; last if $filename; } } } unless ($filename) { $filename = $_[0]->{parameters}->{name}; } return _decode($filename); } sub name { _decode($_[0]->{parameters}->{name}) } sub multipart { $_[0]->{multipart_type} } sub parts { $_[0]->{parts} } sub rfc822_size { $_[0]->{rfc822_size} } sub internaldate { $_[0]->{internaldate} } sub flags { $_[0]->{flags} } sub uid { $_[0]->{uid} } sub part_id { $_[0]->{part_id } } sub md5 { $_[0]->{md5} } sub disposition { $_[0]->{disposition} } sub language { $_[0]->{language} } # envelope sub date { $_[0]->{date} } sub subject { _decode($_[0]->{subject}) } sub from { $_[0]->{from} } sub sender { $_[0]->{sender} } sub reply_to { $_[0]->{reply_to} } sub to { $_[0]->{to} } sub cc { $_[0]->{cc} } sub bcc { $_[0]->{bcc} } sub in_reply_to { $_[0]->{in_reply_to} } sub message_id { $_[0]->{message_id} } sub seq_id { $_[0]->{seq_id} } sub headers { $_[0]->{headers} } # utils sub get_subpart { my ($self, $part) = @_; foreach my $index (split(/\./, $part)) { $self = $self->parts->[$index - 1]; } return $self; } my %MT_HAS_ATTACHMENT = ( mixed => 1 ); sub has_attachments { my ($self) = @_; my $mt = $self->multipart; return $mt && $MT_HAS_ATTACHMENT{$mt} ? 1 : 0; } sub is_message { $_[0]->content_type eq 'message/rfc822' } sub message { $_[0]->{message} } sub _parse_body { my ($self, $struct) = @_; if (ref($struct->[0]) eq 'ARRAY') { my @tmp = @$struct; my $multipart = pop @tmp; my $part_id = $self->{part_id} || ''; $part_id .= '.' if $part_id; my $i = 0; @tmp = map { __PACKAGE__->new({ BODY => $_}, $part_id . ++$i) } @tmp; $self->{multipart_type} = lc $multipart; $self->{parts} = \@tmp; } else { $self->{type} = lc $struct->[0]; $self->{subtype} = lc $struct->[1]; if ($struct->[2]) { my %tmp = @{$struct->[2]}; $self->{parameters} = \%tmp; } $self->{cid} = $struct->[3]; $self->{description} = $struct->[4]; $self->{transfer_encoding} = $struct->[5]; $self->{encoded_size} = $struct->[6]; if ($self->is_message && $struct->[7] && $struct->[8]) { # continue parsing attached message $self->{message} = __PACKAGE__->new({ ENVELOPE => $struct->[7], BODY => $struct->[8], }); } } } sub _parse_bodystructure { my ($self, $struct) = @_; if (ref($struct->[0]) eq 'ARRAY') { my $multipart; my @tmp; foreach (@$struct) { if (ref($_) eq 'ARRAY') { push @tmp, $_; } else { $multipart = $_; last; # XXX: ignoring the rest (extension data) for now. } } my $part_id = $self->{part_id} || ''; $part_id .= '.' if $part_id; my $i = 0; @tmp = map { __PACKAGE__->new({ BODYSTRUCTURE => $_}, $part_id . ++$i) } @tmp; $self->{multipart_type} = lc $multipart; $self->{parts} = \@tmp; } else { $self->{type} = lc $struct->[0]; $self->{subtype} = lc $struct->[1]; my $a = $struct->[2]; if ($a) { __lc_key_in_array($a); my %tmp = @$a; $self->{parameters} = \%tmp; } $self->{cid} = $struct->[3]; $self->{description} = $struct->[4]; $self->{transfer_encoding} = $struct->[5]; $self->{encoded_size} = $struct->[6]; if ($self->is_message && $struct->[7] && $struct->[8]) { # continue parsing attached message $self->{message} = __PACKAGE__->new({ ENVELOPE => $struct->[7], BODYSTRUCTURE => $struct->[8], }); } elsif ($self->type ne 'text') { $self->{md5} = $struct->[7]; my $a = $struct->[8]; if ($a) { for (my $i = 0; $i < @$a; ++$i) { $a->[$i] = lc $a->[$i]; ++$i; if (ref($a->[$i]) eq 'ARRAY') { __lc_key_in_array($a->[$i]); my %foo = @{ $a->[$i] }; $a->[$i] = \%foo; } } my %tmp = @$a; $self->{disposition} = \%tmp; } $self->{language} = $struct->[9]; } } } sub __lc_key_in_array { my ($a) = @_; for (my $i = 0; $i < @$a; $i += 2) { $a->[$i] = lc $a->[$i]; } } sub _parse_envelope { my ($self, $struct) = @_; $self->{date} = $struct->[0]; $self->{subject} = $struct->[1]; $self->{from} = _parse_address($struct->[2]); $self->{sender} = _parse_address($struct->[3]); $self->{reply_to} = _parse_address($struct->[4]); $self->{to} = _parse_address($struct->[5]); $self->{cc} = _parse_address($struct->[6]); $self->{bcc} = _parse_address($struct->[7]); $self->{in_reply_to} = $struct->[8]; $self->{message_id} = $struct->[9]; } sub _parse_address { my ($adr) = @_; if ($adr) { $adr = [ map { Net::IMAP::Client::MsgAddress->new($_) } @$adr ]; } return $adr; } 1; __END__ =pod =head1 NAME Net::IMAP::Client::MsgSummary - parse message (+ subparts) summary info =head1 SYNOPSIS This object is created internally in Net::IMAP::Client->get_summaries. You shouldn't need to instantiate it directly. You can skip the SYNOPSIS, these notes are intended for developers. my $imap = Net::IMAP::Client->new( ... ) $imap->select('INBOX'); # retrieve FETCH lines my ($ok, $lines) = $imap->_tell_imap(FETCH => "$msg_id FULL"); die 'FETCH failed: ' . $imap->last_error unless $ok; # build parsed tokens my @tokens = map { Net::IMAP::Client::_parse_tokens($_) } @$lines; # they look like this: [ '*', 'MSGID', 'FETCH', [ 'FLAGS', [ '\\Seen', '\\Answered' ], 'INTERNALDATE', '13-Aug-2008 14:43:50 +0300', 'RFC822.SIZE', '867', 'ENVELOPE', [ ... ] ... ] Basically it's the IMAP response parsed into a Perl structure (array of tokens). FIXME: this stuff should be documented in Net::IMAP::Client. # make summaries my @summaries = map { my $tokens = $_->[3]; my %hash = @$tokens; Net::IMAP::Client::MsgSummary->new(\%hash); } @tokens; my $summary = shift @summaries; print $summary->subject; print $summary->from->[0]; =head1 DESCRIPTION This object can represent a message or a message part. For example, for a message containing attachments you will be able to call parts() in order to fetch parsed Net::IMAP::Client::MsgSummary objects for each part. Each part in turn may contain other subparts! For example, if a part is of type C then its C method will return it's subparts, if any. There's a distinction between a message and a message part, although we use the same object to represent both. A message will have additional information, fetched from its ENVELOPE (i.e. C, C, C, C, etc.). For a part only, this information will be missing. If all this sounds confusing, you might want to use Data::Dumper to inspect the structure of a complex message. See also the documentation of L's get_summaries method for an example. =head1 API REFERENCE It contains only accessors that return data as retrieved by the FETCH command. Parts that may be MIME-word encoded are automatically undecoded. =head2 C # constructor Parses/creates a new object from the given FETCH data. =over =item C Returns the base MIME type (i.e. 'text') =item C Returns the subtype (i.e. 'plain') =item C Returns any parameters passed in BODY(STRUCTURE). You shouldn't need this. =item C Returns the part's unique identifier (CID). =item C Returns the part's description (usually I). =item C Returns the part's content transfer encoding. You'll need this in order to decode binary parts. =item C Returns the size of the encoded part. This is actually the size in octets that will be downloaded from the IMAP server if you fetch this part only. =item C Shortcut for C<$self->type . '/' .$self->subtype>. =item C Returns the charset declaration for this part. =item C Returns the name of this part, if found in FETCH response. =item C Returns the file name of this part, if found in FETCH response. If there's no filename it will try C. =item C Returns the multipart type (i.e. 'mixed', 'alternative') =item C Returns the subparts of this part. =item C Returns the "id" (path) of this part starting from the toplevel message, i.e. "2.1" (meaning that this is the first subpart of the second subpart of the toplevel message). =item C Returns a MD5 of this part or I if not present. =item C Returns the disposition of this part (I if not present). It's a hash actually that looks like this: { inline => { filename => 'foobar.png' } } =item C Returns the language of this part or I if not present. =item C Returns the size of the full message body. =item C Returns the INTERNALDATE of this message. =item C Returns the flags of this message. =item C Returns the UID of this message. =item C Returns the sequence number of this message, if it has been retrieved! =item C Returns the date of this message (from the Date header). =item C Returns the subject of this message. =item C, C, C, C, C, C Returns an array of Net::IMAP::Client::MsgAddress objects containing the respective addresses. Note that sometimes this array can be empty! =item C Returns the ID of the "parent" message (to which this one has been replied). This is NOT the "UID" of the message! =item C Returns the ID of this message (from the Message-ID header). =item C ($path) Returns the subpart of this message identified by $path, which is in form '1.2' etc. Returns undef if no such path was found. Here's a possible message structure: - Container (multipart/mixed) has no path ID; it's the toplevel message. It contains the following subparts: 1 multipart/related 1.1 text/html 1.2 image/png (embedded in HTML) 2 message/rfc822 (decoded type is actually multipart/related) 2.1 text/html 2.2 image/png (also embedded) C called on the container will return the respective Net::IMAP::Client::MsgSummary part, i.e. get_subpart('2.1') will return the text/html part of the attached message. =item C Tries to determine if this message has attachments. For now this checks if the multipart type is 'mixed', which isn't really accurate. =item C Returns true if this object represents a message (i.e. has content_type eq 'message/rfc822'). Note that it won't return true for the toplevel part, but you B that that part represents a message. ;-) =item C Returns the attached rfc822 message =item C Returns (unparsed, as plain text) additional message headers if they were fetched by get_summaries. You can use L to parse them. =back =head1 TODO Fix C =head1 SEE ALSO L, L =head1 AUTHOR Mihai Bazon, http://www.dynarchlib.com/ http://www.bazon.net/mishoo/ =head1 COPYRIGHT Copyright (c) Mihai Bazon 2008. All rights reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTY BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR, OR CORRECTION. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. =cut Net-IMAP-Client-0.9505/lib/Net/IMAP/Client/MsgAddress.pm0000644000175000017500000000657611115456157021216 0ustar jrothjrothpackage Net::IMAP::Client::MsgAddress; use Encode (); sub new { my ($class, $struct) = @_; my $self = { name => $struct->[0], at_domain_list => $struct->[1], mailbox => $struct->[2], host => $struct->[3], }; bless $self, $class; } sub _decode { my ($str) = @_; if (defined($str)) { eval { $str = Encode::decode('MIME-Header', $str); }; } return $str; } use overload q("") => \&as_string; sub name { _decode($_[0]->{name}) } sub at_domain_list { _decode($_[0]->{at_domain_list}) } sub mailbox { _decode($_[0]->{mailbox}) } sub host { _decode($_[0]->{host}) } sub email { my ($self) = @_; return $self->mailbox . '@' . $self->host; } sub as_string { my ($self) = @_; my $str; if (($str = $self->name)) { $str .= ' <' . $self->email . '>'; } else { $str = $self->email; } return $str; } 1; __END__ =pod =head1 NAME Net::IMAP::Client::MsgAddress =head1 DESCRIPTION Represents one email address as returned in an ENVELOPE part of the FETCH command. When used in string context, this object magically translates to S<"Full Name Eemail@address.comE">. =head1 METHODS =head2 C # constructor Creates a new object from the given array. =over =item name Returns the full name, if any =item at_domain_list Returns the "at_domain_list" part (WTF is that?) =item mailbox Returns the mailbox name (i.e. the 'email' part in the example above). =item host Returns the host name (i.e. the 'address.com' part). =item email Returns the full email address: C<$self->{mailbox} . '@' . $self->{host}>. =item as_string Used by stringification. It returns the full name and email address as in S<"Full Name Eemail@address.comE">. =back =head1 SEE ALSO L, L =head1 AUTHOR Mihai Bazon, http://www.dynarchlib.com/ http://www.bazon.net/mishoo/ =head1 COPYRIGHT Copyright (c) Mihai Bazon 2008. All rights reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTY BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR, OR CORRECTION. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. =cut Net-IMAP-Client-0.9505/META.yml0000664000175000017500000000120412362255466014623 0ustar jrothjroth--- abstract: 'Not so simple IMAP client library' author: - 'Mihai Bazon ' build_requires: ExtUtils::MakeMaker: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.68, CPAN::Meta::Converter version 2.140640' license: unknown meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Net-IMAP-Client no_index: directory: - t - inc requires: Encode: '0' Encode::MIME::Header: '0' IO::Socket::INET: '0' IO::Socket::SSL: '0' List::MoreUtils: '0' List::Util: '0' Test::More: '0' version: '0.9505' Net-IMAP-Client-0.9505/MANIFEST0000644000175000017500000000052712362255466014510 0ustar jrothjrothChanges MANIFEST Makefile.PL README lib/Net/IMAP/Client.pm lib/Net/IMAP/Client/MsgAddress.pm lib/Net/IMAP/Client/MsgSummary.pm t/00-load.t t/pod-coverage.t t/pod.t t/boilerplate.t META.yml Module meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Net-IMAP-Client-0.9505/Changes0000644000175000017500000000714112266505402014640 0ustar jrothjrothRevision history for Net-IMAP-Client 0.95 Apr 9, 2011 - fix #48163 error after logout - add examine() method (identical to select(); keyword differs) 0.94 Dec 22, 2010 - fix #56647 rfc822 attachment mishandling - fix #43046 Does not strip \r from error messages - fix #59462, #43047 creation of non-modifiable array attempted - fix #43049 append() method's documentation - fix status(): avoid returning data from undef key 0.93 - add namespace() method - modify get_summaries() to always return array ref 0.92 Feb 28, 2009 - Doc updates 0.91 Feb 27, 2009 Fixed get_summary to correctly identify the attachment filenames with GMail's IMAP (GMail sends some headers in uppercase). 0.10 * unreleased * get_summaries now supports fetching additional headers. They are available (unparsed) via the $summary->headers method (where $summary is a Net::IMAP::Client::MsgSummary object). Minor cleanups and speed improvement. 0.9 Jan 25, 2009 - more fixes for cyrus imap server: get_flags and get_summaries 0.8 Jan 20, 2009 - updated dependencies (Encode isn't core in Perl 5.6) - fixed status() on uw-imap (server can return "NO CLIENT BUG DETECTED ..." when called on the selected mailbox). Thanks Max Maischein (corion.net). 0.7 Jan 13, 2009 - fixed get_flags (thanks Peter Pilsl for the report) 0.6 Nov 09, 2008 - better reconnect support (check that value of getline is undef and force reconnect if so) 0.5 Oct 31, 2008 - added new methods: create_folder, delete_folder, copy, get_flags, get_threads, fetch - fixed some bugs with append 0.4 Sep 22, 2008 - added append / expunge - added store, add_flags, del_flags, delete_message - heavily modified _send_cmd() to support literals - try to reconnect when connection is lost Fixes: - subtle bug related to using syswrite / sysread (now using only buffered I/O) - return proper notifications from get_part_body and get_parts_bodies (sometimes the \Seen flag becomes set, this must be reported.) - return references in get_parts_bodies - _parse_tokens now interprets BODY[*] as an atom - fixed BODYSTRUCTURE parser in MsgSummary.pm (sometimes the server would include additional extension data which we don't support and must be properly discarded) 0.3 Sep 08, 2008 Fix for http://rt.cpan.org/Ticket/Display.html?id=39078 - return undef from constructor when connection failed. 0.2 Sep 02, 2008 There are some disruptive changes, I hope no one took this module seriously yet. :-p - some support for server notifications. N/I/C will try to keep up with notifications involving \Deleted or \Seen flags (i.e. updating $imap->{FOLDERS}{$current_folder}) and it also can report an array of notifications after some commands. See the notifications() method. - new methods: folders_more(), noop(), get_parts_bodies(), capability(), seq_to_uid() - got rid of wantarray for most methods (the exception is folders()) - status() now returns a hashref instead of an array; needed since the IMAP STATUS command might actually fail for some folders. - most methods in Net::IMAP::Client::MsgAddress and Net::IMAP::Client::MsgSummary will now decode the data (previously it left it "MIME-Word"-encoded). - fixed dependencies in Makefile.PL -- hopefully 0.1 Aug 23, 2008 First public release. Net-IMAP-Client-0.9505/t/0000755000175000017500000000000012362255466013616 5ustar jrothjrothNet-IMAP-Client-0.9505/t/pod.t0000644000175000017500000000035011115456157014556 0ustar jrothjroth#!perl -T use strict; use warnings; use Test::More; # Ensure a recent version of Test::Pod my $min_tp = 1.22; eval "use Test::Pod $min_tp"; plan skip_all => "Test::Pod $min_tp required for testing POD" if $@; all_pod_files_ok(); Net-IMAP-Client-0.9505/t/pod-coverage.t0000644000175000017500000000104711115456157016353 0ustar jrothjrothuse strict; use warnings; use Test::More; # Ensure a recent version of Test::Pod::Coverage my $min_tpc = 1.08; eval "use Test::Pod::Coverage $min_tpc"; plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage" if $@; # Test::Pod::Coverage doesn't require a minimum Pod::Coverage version, # but older versions don't recognize some common documentation styles my $min_pc = 0.18; eval "use Pod::Coverage $min_pc"; plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage" if $@; all_pod_coverage_ok(); Net-IMAP-Client-0.9505/t/boilerplate.t0000644000175000017500000000245111115456157016302 0ustar jrothjroth#!perl -T use strict; use warnings; use Test::More tests => 3; sub not_in_file_ok { my ($filename, %regex) = @_; open( my $fh, '<', $filename ) or die "couldn't open $filename for reading: $!"; my %violated; while (my $line = <$fh>) { while (my ($desc, $regex) = each %regex) { if ($line =~ $regex) { push @{$violated{$desc}||=[]}, $.; } } } if (%violated) { fail("$filename contains boilerplate text"); diag "$_ appears on lines @{$violated{$_}}" for keys %violated; } else { pass("$filename contains no boilerplate text"); } } sub module_boilerplate_ok { my ($module) = @_; not_in_file_ok($module => 'the great new $MODULENAME' => qr/ - The great new /, 'boilerplate description' => qr/Quick summary of what the module/, 'stub function definition' => qr/function[12]/, ); } TODO: { local $TODO = "Need to replace the boilerplate text"; not_in_file_ok(README => "The README is used..." => qr/The README is used/, "'version information here'" => qr/to provide version information/, ); not_in_file_ok(Changes => "placeholder date/time" => qr(Date/time) ); module_boilerplate_ok('lib/Net/IMAP/Client.pm'); } Net-IMAP-Client-0.9505/t/00-load.t0000755000175000017500000000024411115456157015135 0ustar jrothjroth#!perl -T use Test::More tests => 1; BEGIN { use_ok( 'Net::IMAP::Client' ); } diag( "Testing Net::IMAP::Client $Net::IMAP::Client::VERSION, Perl $], $^X" ); Net-IMAP-Client-0.9505/META.json0000664000175000017500000000212012362255466014771 0ustar jrothjroth{ "abstract" : "Not so simple IMAP client library", "author" : [ "Mihai Bazon " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.68, CPAN::Meta::Converter version 2.140640", "license" : [ "unknown" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Net-IMAP-Client", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Encode" : "0", "Encode::MIME::Header" : "0", "IO::Socket::INET" : "0", "IO::Socket::SSL" : "0", "List::MoreUtils" : "0", "List::Util" : "0", "Test::More" : "0" } } }, "release_status" : "stable", "version" : "0.9505" }