File Coverage

blib/lib/Net/IMAP/Simple/Gmail.pm

Criterion	Covered	Total	%
statement	12	51	23.5
branch	0	14	0.0
condition			n/a
subroutine	4	20	20.0
pod	5	6	83.3
total	21	91	23.0

package Net::IMAP::Simple::Gmail;
use Text::ParseWords;
use strict;

use vars qw[$VERSION];
$VERSION = (qw$Revision: 0.21 $)[1];

use base qw[Net::IMAP::Simple::SSL];


sub run_search {
    my ( $self, $search_terms ) = @_;
    my @hits;

    return $self->_process_cmd(
        cmd => [ SEARCH => qq[X-GM-RAW "$search_terms"] ],
	final => sub {
	    return \@hits;
	},
        process => sub {
	    if ( $_[0] =~ /^\* SEARCH (.*)\s*$/ ) {
		@hits = split / /, $1;
	    }
	},
	);
}



sub get_msgids {
    my ( $self, $number ) = @_;
    return $self->_get_gminfo( $number, 'X-GM-MSGID' );
}

sub get_threadids {
    my ( $self, $number ) = @_;
    return $self->_get_gminfo( $number, 'X-GM-THRID' );
}


sub _get_gminfo {
    my ( $self, $number, $gm_identifier ) = @_;
    my %threadid;

    return $self->_process_cmd(
        cmd => [ FETCH => qq[$number ($gm_identifier)] ],
	final => sub {
	    # if range, return hashref, else scalar
	    return ($number =~ /:/) ? \%threadid : $threadid{$number};
	},
        process => sub {
	    foreach (@_) {
		if ( $_ =~ /^\* (\d+) FETCH \($gm_identifier (\d+)\)\s*$/ ) {
		    my ($num, $label) = ($1, $2);
		    $threadid{$1} = $2;
		}
	    }
	},
	);
}

sub get_labels {
    my ( $self, $number ) = @_;
    my %labels;

    return $self->_process_cmd(
        cmd => [ FETCH => qq[$number (X-GM-LABELS)] ],
	final => sub {
	    # if range, return hashref else arrayrg
	    return ($number =~ /:/) ? \%labels : $labels{$number};
	},
        process => sub {
	    foreach (@_) {
		if ( $_ =~ /^\* (\d+) FETCH \(X-GM-LABELS \((.+)\)\)\s*$/ ) {
		    my ($num, $label) = ($1, $2);
		    my @labels = Text::ParseWords::parse_line(' ', 0, $label);
		    $labels{$num} = \@labels;
		}
	    }
	},
	);
}


sub add_labels {
    my ( $self, $number, @labels ) = @_;
    return $self->_label_manip( $number, '+X-GM-LABELS', @labels );
}

sub remove_labels {
    my ( $self, $number, @labels ) = @_;
    return $self->_label_manip( $number, '-X-GM-LABELS', @labels );
}


sub _label_manip {
    my ( $self, $number, $op, @labels ) = @_;
    return unless @labels;

    # quote labels with spaces
    @labels = map { / / ? '"' . $_ . '"' : $_ } @labels;
    my $label_line = join ' ', @labels;

    return $self->_process_cmd(
        cmd     => [ STORE => qq[$number $op ($label_line)] ],
        final   => sub { },
        process => sub { },
    );

}

1;

__END__