├── .gitignore ├── .travis.yml ├── Changes ├── LICENSE ├── README.pod ├── bin └── gmail-imap-label ├── dist.ini ├── doc ├── example.muttrc └── example.offlineimaprc ├── lib └── Net │ └── Gmail │ └── IMAP │ ├── Label.pm │ └── Label │ └── Proxy.pm └── t ├── 00_packages.t ├── 00_usage.t ├── 01_get_label.t └── 02_put_label.t /.gitignore: -------------------------------------------------------------------------------- 1 | .*.sw* 2 | Net-Gmail-IMAP-Label-* 3 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: perl 2 | cache: 3 | directories: 4 | # local::lib caching 5 | - $HOME/perl5 6 | addons: 7 | apt: 8 | packages: 9 | - aspell # for dzil Test::PodSpelling 10 | - aspell-en # for dzil Test::PodSpelling 11 | matrix: 12 | include: 13 | - perl: "5.16" 14 | os: linux 15 | dist: trusty 16 | sudo: false 17 | - perl: "5.18" 18 | env: COVERAGE=1 # enables coverage+coveralls reporting 19 | os: linux 20 | dist: trusty 21 | sudo: false 22 | - perl: "5.20" 23 | os: linux 24 | dist: trusty 25 | sudo: false 26 | - perl: "5.26" 27 | os: linux 28 | dist: trusty 29 | sudo: false 30 | - perl: "blead" 31 | os: linux 32 | dist: trusty 33 | sudo: false 34 | allow_failures: 35 | - perl: blead # ignore failures for blead perl 36 | sudo: false # faster builds as long as you don't need sudo access 37 | before_install: 38 | - export DEVOPS_BRANCH="master" 39 | - eval "$(curl https://raw.githubusercontent.com/project-renard/devops/$DEVOPS_BRANCH/script/helper.pl | perl -- | awk '/^#START/,/^#END/ { print > "/dev/stdout"; next } { print > "/dev/stderr"}' )" 40 | -------------------------------------------------------------------------------- /Changes: -------------------------------------------------------------------------------- 1 | 0.008 2018-04-09 08:33:36-0400 2 | 3 | Features 4 | 5 | - Documentation updates. 6 | 7 | Bug fixes 8 | 9 | - Escape left and right literal braces in regex. 10 | See . 11 | 12 | Build changes 13 | 14 | - Switch to using @Author::ZMUGHAL dzil plugin bundle. 15 | See . 16 | 17 | - Implement Travis CI continuous integration. 18 | See 19 | 20 | 0.007 2013-02-10 16:17:52-0600 21 | - add metadata to distribution 22 | - improve documentation 23 | 24 | 0.006 2012-12-12 12:46:35-0600 25 | - minimum version for Capture::Tiny 26 | 27 | 0.005 2012-12-08 15:18:49-0600 28 | - more correct regex quantifier 29 | 30 | 0.004 2012-12-08 15:18:49-0600 31 | - fix documentation 32 | - change IMAP response matching to handle quoting of labels (specifically for 33 | parentheses) 34 | 35 | 0.003 2012-12-07 11:12:21-0600 36 | - add dzil plugin to check changelog 37 | 38 | 0.002 2012-12-07 11:05:47-0600 39 | - change dzil license to Artistic 2.0 40 | 41 | 0.001 2012-12-07 04:03:08-0600 42 | - change to module distribution 43 | - add command-line options 44 | - add tests for request/response filter map 45 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | This software is made available under the ISC license: 2 | 3 | Copyright (c) 2011, Zakariyya Mughal 4 | 5 | Permission to use, copy, modify, and/or distribute this software for any 6 | purpose with or without fee is hereby granted, provided that the above 7 | copyright notice and this permission notice appear in all copies. 8 | 9 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 | 17 | --- 18 | 19 | Or the Artistic License version 2. 20 | -------------------------------------------------------------------------------- /README.pod: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding UTF-8 4 | 5 | =head1 NAME 6 | 7 | Net::Gmail::IMAP::Label - IMAP proxy for Google's Gmail that retrieves message labels 8 | 9 | =head1 VERSION 10 | 11 | version 0.008 12 | 13 | =head1 SYNOPSIS 14 | 15 | gmail-imap-label [OPTION]... 16 | 17 | =head1 DESCRIPTION 18 | 19 | This module provides a proxy that sits between an IMAP client and Gmail's IMAPS 20 | server and adds GMail labels to the X-Label header. This proxy uses the 21 | L. 22 | 23 | To use this proxy, your e-mail client will need to connect to the proxy using 24 | the IMAP protocol (without SSL). 25 | 26 | =head1 EXAMPLES 27 | 28 | The simplest way of starting is to run the proxy on the default port of 10143: 29 | 30 | gmail-imap-label 31 | 32 | An alternative port can be specified using the B<--port> option 33 | 34 | gmail-imap-label --port 993 35 | 36 | The proxy has been tested with both mutt (v1.5.21) and offlineimap (v6.3.4). 37 | Example configuration files for these are available in the C directory. 38 | 39 | With mutt, you may have to clear the header cache every so often so that any 40 | updated labels are available inside the UI. 41 | 42 | =head1 INSTALLATION 43 | 44 | You can either install the package from L 45 | or from your package manager. 46 | 47 | To install the L, 48 | run 49 | 50 | apt-get install libnet-gmail-imap-label-perl 51 | 52 | =head1 SEE ALSO 53 | 54 | See L for a complete listing of options. 55 | 56 | =head1 BUGS 57 | 58 | Report bugs and submit patches to the repository on L. 59 | 60 | =head1 COPYRIGHT 61 | 62 | Copyright 2011 Zakariyya Mughal. 63 | 64 | This program is free software; you can redistribute it and/or 65 | modify it under the terms of either: 66 | 67 | =over 4 68 | 69 | =item * the ISC license, or 70 | 71 | =item * the Artistic License version 2.0. 72 | 73 | =back 74 | 75 | =head1 ACKNOWLEDGMENTS 76 | 77 | Thanks to L for pointing out the 78 | Gmail IMAP extensions that made this a whole lot easier than what I had 79 | originally planned on doing. 80 | 81 | =head1 AUTHOR 82 | 83 | Zakariyya Mughal 84 | 85 | =head1 COPYRIGHT AND LICENSE 86 | 87 | This software is Copyright (c) 2011 by Zakariyya Mughal . 88 | 89 | This is free software, licensed under: 90 | 91 | The Artistic License 2.0 (GPL Compatible) 92 | 93 | =cut 94 | -------------------------------------------------------------------------------- /bin/gmail-imap-label: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | # PODNAME: gmail-imap-label 3 | # ABSTRACT: IMAP proxy for Google's Gmail that retrieves message labels 4 | 5 | use strict; 6 | use warnings; 7 | use FindBin qw($Bin); 8 | use lib "$Bin/../lib"; 9 | use Net::Gmail::IMAP::Label 'run'; 10 | 11 | __END__ 12 | 13 | =head1 NAME 14 | 15 | gmail-imap-label - IMAP proxy for Google's Gmail that retrieves message labels 16 | 17 | =head1 SYNOPSIS 18 | 19 | gmail-imap-label [-?hpv] [long options...] 20 | 21 | -p --port local port to connect to (default: 10143) 22 | -v --verbose increase verbosity (multiple flags for more verbosity) 23 | -? -h --help print usage message and exit 24 | 25 | =head1 OPTIONS 26 | 27 | =over 8 28 | 29 | =item B<-p I>, B<--port I> 30 | 31 | Set the local port for the IMAP proxy. The default port is 10143. 32 | 33 | =item B<-v>, B<--verbose> 34 | 35 | Set the verbosity level. Multiple flags increase the verbosity level 36 | (e.g. -v, -vv, -vvv). 37 | 38 | =item B<-h>, B<-?>, B<--help> 39 | 40 | Print a brief help message and exits. 41 | 42 | =back 43 | 44 | =head1 SEE ALSO 45 | 46 | Description of proxy available in L. 47 | 48 | =cut 49 | -------------------------------------------------------------------------------- /dist.ini: -------------------------------------------------------------------------------- 1 | name = Net-Gmail-IMAP-Label 2 | author = Zakariyya Mughal 3 | license = Artistic_2_0 4 | copyright_holder = Zakariyya Mughal 5 | copyright_year = 2011 6 | version = 0.008 7 | 8 | [@Filter] 9 | -bundle = @Author::ZMUGHAL 10 | -remove = License 11 | -------------------------------------------------------------------------------- /doc/example.muttrc: -------------------------------------------------------------------------------- 1 | # Copy this to ~/.muttrc and edit 2 | 3 | set folder = "imap://localhost:10143" # LOCALPORT in gmail-imap-label 4 | set spoolfile = "+INBOX" 5 | set postponed="+[Gmail]/Drafts" 6 | 7 | set imap_user = "user@gmail.com" 8 | set imap_pass = "password" 9 | 10 | set smtp_url = "smtp://user@smtp.gmail.com:587/" 11 | set smtp_pass = "password" 12 | 13 | # show labels in index view: %y, %Y 14 | set index_format="%4C %Z %3N %{%b %d} %-15.15L (%?M?[%2M]&%4c?) %?y?{%-10.10y} ?%s" 15 | # show labels in message view 16 | unignore X-Label 17 | 18 | # vim: ft=muttrc 19 | -------------------------------------------------------------------------------- /doc/example.offlineimaprc: -------------------------------------------------------------------------------- 1 | # Copy this to ~/.offlineimaprc and edit 2 | 3 | [general] 4 | accounts = Gmail 5 | 6 | [Account Gmail] 7 | localrepository = GmailBox 8 | remoterepository = GmailProxy 9 | 10 | [Repository GmailBox] 11 | type = Maildir 12 | localfolders = ~/Gmail 13 | 14 | [Repository GmailProxy] 15 | type = IMAP 16 | remotehost = localhost 17 | remoteport = 10143 # from LOCALPORT in gmail-imap-label 18 | remoteuser = user@gmail.com 19 | -------------------------------------------------------------------------------- /lib/Net/Gmail/IMAP/Label.pm: -------------------------------------------------------------------------------- 1 | package Net::Gmail::IMAP::Label; 2 | # ABSTRACT: IMAP proxy for Google's Gmail that retrieves message labels 3 | 4 | use strict; 5 | use warnings; 6 | use Net::Gmail::IMAP::Label::Proxy; 7 | use Getopt::Long::Descriptive; 8 | 9 | sub import { 10 | my ($class, @opts) = @_; 11 | return unless (@opts == 1 && $opts[0] eq 'run'); 12 | $class->run; 13 | } 14 | 15 | sub run { 16 | my ($opts, $usage) = describe_options( 17 | "$0 %o", 18 | [ 'port|p=i', "local port to connect to (default: @{[Net::Gmail::IMAP::Label::Proxy::DEFAULT_LOCALPORT]})", { default => Net::Gmail::IMAP::Label::Proxy::DEFAULT_LOCALPORT } ], 19 | [ 'verbose|v+', "increase verbosity (multiple flags for more verbosity)" , { default => 0 } ], 20 | [ 'help|h|?', "print usage message and exit" ], 21 | ); 22 | 23 | if($opts->help) { 24 | print($usage->text); 25 | return 1; 26 | } 27 | 28 | Net::Gmail::IMAP::Label::Proxy->new(localport => $opts->port, verbose => $opts->verbose)->run(); 29 | } 30 | 31 | 1; 32 | 33 | =head1 SYNOPSIS 34 | 35 | gmail-imap-label [OPTION]... 36 | 37 | =head1 DESCRIPTION 38 | 39 | This module provides a proxy that sits between an IMAP client and Gmail's IMAPS 40 | server and adds GMail labels to the X-Label header. This proxy uses the 41 | L. 42 | 43 | To use this proxy, your e-mail client will need to connect to the proxy using 44 | the IMAP protocol (without SSL). 45 | 46 | =head1 EXAMPLES 47 | 48 | The simplest way of starting is to run the proxy on the default port of 10143: 49 | 50 | gmail-imap-label 51 | 52 | An alternative port can be specified using the B<--port> option 53 | 54 | gmail-imap-label --port 993 55 | 56 | The proxy has been tested with both mutt (v1.5.21) and offlineimap (v6.3.4). 57 | Example configuration files for these are available in the C directory. 58 | 59 | With mutt, you may have to clear the header cache every so often so that any 60 | updated labels are available inside the UI. 61 | 62 | =head1 INSTALLATION 63 | 64 | You can either install the package from L 65 | or from your package manager. 66 | 67 | To install the L, 68 | run 69 | 70 | apt-get install libnet-gmail-imap-label-perl 71 | 72 | =head1 SEE ALSO 73 | 74 | See L for a complete listing of options. 75 | 76 | =head1 BUGS 77 | 78 | Report bugs and submit patches to the repository on L. 79 | 80 | =head1 COPYRIGHT 81 | 82 | Copyright 2011 Zakariyya Mughal. 83 | 84 | This program is free software; you can redistribute it and/or 85 | modify it under the terms of either: 86 | 87 | =over 4 88 | 89 | =item * the ISC license, or 90 | 91 | =item * the Artistic License version 2.0. 92 | 93 | =back 94 | 95 | =head1 ACKNOWLEDGMENTS 96 | 97 | Thanks to L for pointing out the 98 | Gmail IMAP extensions that made this a whole lot easier than what I had 99 | originally planned on doing. 100 | 101 | =cut 102 | 103 | # vim:ts=4:sw=4 104 | -------------------------------------------------------------------------------- /lib/Net/Gmail/IMAP/Label/Proxy.pm: -------------------------------------------------------------------------------- 1 | package Net::Gmail::IMAP::Label::Proxy; 2 | # ABSTRACT: Implementation of proxy logic for FETCH X-GM-LABELS 3 | 4 | use warnings; 5 | use strict; 6 | use POE qw(Component::Server::TCP Component::Client::TCP 7 | Filter::Stackable Filter::Map); 8 | use POE::Component::SSLify qw( Client_SSLify ); 9 | use Regexp::Common; 10 | use Encode::IMAPUTF7; 11 | use Encode qw/decode encode_utf8/; 12 | use Carp; 13 | 14 | use constant DEFAULT_LOCALPORT => 10143; 15 | use constant LINESEP => "\x0D\x0A"; 16 | use constant GMAIL_HOST => 'imap.gmail.com'; 17 | use constant GMAIL_PORT => 993; # IMAPS port 18 | 19 | # options 20 | # * localport : (0..65535) - port to start local side of proxy 21 | # * verbose : (0..4) - logging level 22 | sub new { 23 | my $class = shift; 24 | ref($class) and croak "class name needed"; 25 | my %opts = @_; 26 | my $self = {}; 27 | bless $self, $class; 28 | $self->{verbose} = $opts{verbose} // 0; 29 | $self->{localport} = $opts{localport} // DEFAULT_LOCALPORT; 30 | $self; 31 | } 32 | 33 | sub run { 34 | my ($self) = @_; 35 | $self->init() unless $self->{_init}; 36 | $self->{verbose} and carp 'running'; 37 | $poe_kernel->run(); 38 | } 39 | 40 | # Spawn the forwarder server on port given in by localport option. When new 41 | # connections arrive, spawn clients to connect them to their destination. 42 | sub init { 43 | my ($self) = @_; 44 | POE::Component::Server::TCP->new( 45 | Port => $self->{localport}, 46 | ClientConnected => sub { 47 | my ($heap, $session) = @_[HEAP, SESSION]; 48 | $self->{verbose} > 0 and logevent('server got connection', $session); 49 | $heap->{client_id} = $self->spawn_client_side(); 50 | }, 51 | ClientFilter => POE::Filter::Stackable->new( 52 | Filters => [ 53 | POE::Filter::Line->new( Literal => LINESEP), 54 | POE::Filter::Map->new( Get => \&get_label, Put => \&put_label ), 55 | ]), 56 | ClientInput => sub { 57 | my ($kernel, $session, $heap, $input) = @_[KERNEL, SESSION, HEAP, ARG0]; 58 | $self->{verbose} > 2 and logevent('server got input', $session, $self->{verbose} > 3 ? $input : undef); 59 | $kernel->post($heap->{client_id} => send_stuff => $input); 60 | }, 61 | ClientDisconnected => sub { 62 | my ($kernel, $session, $heap) = @_[KERNEL, SESSION, HEAP]; 63 | $self->{verbose} > 0 and logevent('server got disconnect', $session); 64 | $kernel->post($heap->{client_id} => "shutdown"); 65 | }, 66 | InlineStates => { 67 | send_stuff => sub { 68 | my ($heap, $stuff) = @_[HEAP, ARG0]; 69 | $self->{verbose} > 2 and logevent("sending to server", $_[SESSION], $self->{verbose} > 3 ? $stuff : undef ); 70 | eval { $heap->{client}->put($stuff); }; 71 | }, 72 | }, 73 | ); 74 | $self->{_init} = 1; # set init flag 75 | } 76 | 77 | sub spawn_client_side { 78 | my ($self) = @_; 79 | POE::Component::Client::TCP->new( 80 | RemoteAddress => GMAIL_HOST, 81 | PreConnect => sub { 82 | # Convert the socket into an SSL socket. 83 | my $socket = eval { Client_SSLify($_[ARG0]) }; 84 | return if $@; # Disconnect if SSL failed. 85 | return $socket; 86 | }, 87 | RemotePort => GMAIL_PORT, # IMAPS port 88 | Filter => POE::Filter::Line->new( Literal => LINESEP), 89 | Started => sub { 90 | $_[HEAP]->{server_id} = $_[SENDER]->ID; 91 | }, 92 | Connected => sub { 93 | my ($heap, $session) = @_[HEAP, SESSION]; 94 | $self->{verbose} > 0 and logevent('client connected', $session); 95 | eval { $heap->{server}->put(''); }; 96 | }, 97 | ServerInput => sub { 98 | my ($kernel, $heap, $session, $input) = @_[KERNEL, HEAP, SESSION, ARG0]; 99 | $self->{verbose} > 1 and logevent('client got input', $session, $self->{verbose} > 2 ? $input : undef); 100 | # TODO: check capabilities? 101 | $kernel->post($heap->{server_id} => send_stuff => $input); 102 | }, 103 | Disconnected => sub { 104 | my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION]; 105 | $self->{verbose} > 0 and logevent('client disconnected', $session); 106 | $kernel->post($heap->{server_id} => 'shutdown'); 107 | }, 108 | ConnectError => sub { 109 | my ($operation, $error_number, $error_string) = @_[ARG0..ARG2]; 110 | my $id = $_[SESSION]->ID; 111 | print STDERR "Client $id: $operation error $error_number occurred: $error_string\n"; 112 | $_[KERNEL]->post($_[HEAP]->{server_id} => 'shutdown'); 113 | }, 114 | InlineStates => { 115 | send_stuff => sub { 116 | my ($heap, $stuff) = @_[HEAP, ARG0]; 117 | $self->{verbose} > 2 and logevent("sending to client", $_[SESSION], $self->{verbose} > 3 ? $stuff : undef); 118 | eval { $heap->{server}->put($stuff); }; 119 | }, 120 | }, 121 | ); 122 | } 123 | 124 | sub logevent { 125 | my ($state, $session, $arg) = @_; 126 | my $id = $session->ID(); 127 | print "session $id $state "; 128 | print ": $arg" if (defined $arg); 129 | print "\n"; 130 | } 131 | 132 | sub get_label { 133 | my $data = shift; 134 | if($data =~ /^\w+ FETCH/) { 135 | $data =~ s,(BODY\.PEEK\[[^\]]*\]),$1 X-GM-LABELS,; 136 | } elsif($data =~ /^\w+ UID FETCH (\d+) \(?BODY.PEEK\[\]\)?$/) { 137 | $data =~ s,\(?(BODY.PEEK\[\])\)?,($1 X-GM-LABELS),; 138 | } 139 | return $data; 140 | } 141 | 142 | sub put_label { 143 | my $data = shift; 144 | my $fetch_re = qr/^\* \d+ FETCH.*{\d+}$/; 145 | my $label_re = qr/(?:[^() "]+)|$RE{delimited}{-delim=>'"'}/; 146 | my $fetch_gm_label = qr/^(\* \d+ FETCH.*)(X-GM-LABELS \((?:(?:$label_re\s+)*$label_re)?\) ?)(.*)\{(\d+)\}$/; 147 | if( $data =~ $fetch_gm_label ) { 148 | my $octets = $4; 149 | my $new_fetch = "$1$3"; 150 | #print "$new_fetch\n"; 151 | (my $x_label = $2) =~ /\((.*)\)/; 152 | $x_label = $1; 153 | $x_label =~ s,"\\\\Important"\s*,,; 154 | $x_label =~ s,"\\\\Sent"\s*,,; 155 | $x_label =~ s,"\\\\Starred"\s*,,; 156 | $x_label =~ s,"\\\\Inbox",INBOX,; 157 | $x_label =~ s,^\s+,,; $x_label =~ s,\s+$,,; # trim 158 | # Gmail sends IMAP's modified UTF-7, 159 | # need to convert to UTF-8 to satisfy 160 | # in mutt 161 | $x_label = decode('IMAP-UTF-7', $x_label); 162 | if(length($x_label) > 0) { 163 | $x_label = "X-Label: $x_label"; 164 | #print "$x_label\n"; 165 | $octets += length(encode_utf8($x_label))+length(LINESEP); # 2 more for line separator 166 | $new_fetch .= "{$octets}"; 167 | $new_fetch .= LINESEP; 168 | $new_fetch .= $x_label; 169 | } else { 170 | $new_fetch .= "{$octets}"; 171 | } 172 | return $new_fetch; 173 | } 174 | return $data; 175 | } 176 | 177 | 1; 178 | 179 | # vim:ts=4:sw=4 180 | -------------------------------------------------------------------------------- /t/00_packages.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use Test::More; 4 | 5 | BEGIN { use_ok( 'Net::Gmail::IMAP::Label' ); } 6 | require_ok( 'Net::Gmail::IMAP::Label' ); 7 | 8 | BEGIN { use_ok( 'Net::Gmail::IMAP::Label::Proxy' ); } 9 | require_ok( 'Net::Gmail::IMAP::Label::Proxy' ); 10 | 11 | done_testing; 12 | -------------------------------------------------------------------------------- /t/00_usage.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use Test::More; 4 | use Capture::Tiny qw/capture_stdout/; 5 | 6 | BEGIN { use_ok( 'Net::Gmail::IMAP::Label' ); } 7 | require_ok( 'Net::Gmail::IMAP::Label' ); 8 | 9 | # test --help 10 | @ARGV = qw/-h/; 11 | my $usage_msg = capture_stdout { Net::Gmail::IMAP::Label->run }; 12 | 13 | like($usage_msg, qr/--help/, 'has --help option'); 14 | like($usage_msg, qr/--port/, 'has --port option'); 15 | like($usage_msg, qr/--verbose/, 'has --verbose option'); 16 | 17 | done_testing; 18 | -------------------------------------------------------------------------------- /t/01_get_label.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use Test::More; 4 | 5 | BEGIN { use_ok( 'Net::Gmail::IMAP::Label::Proxy' ); } 6 | require_ok( 'Net::Gmail::IMAP::Label::Proxy' ); 7 | 8 | my $data = { 9 | 'a0006 FETCH 1:301 (UID FLAGS INTERNALDATE RFC822.SIZE BODY.PEEK[HEADER.FIELDS (DATE FROM SUBJECT TO CC MESSAGE-ID REFERENCES CONTENT-TYPE CONTENT-DESCRIPTION IN-REPLY-TO REPLY-TO LINES LIST-POST X-LABEL)])' => 10 | 'a0006 FETCH 1:301 (UID FLAGS INTERNALDATE RFC822.SIZE BODY.PEEK[HEADER.FIELDS (DATE FROM SUBJECT TO CC MESSAGE-ID REFERENCES CONTENT-TYPE CONTENT-DESCRIPTION IN-REPLY-TO REPLY-TO LINES LIST-POST X-LABEL)] X-GM-LABELS)', 11 | 'a0054 UID FETCH 39468 (BODY.PEEK[])' => 12 | 'a0054 UID FETCH 39468 (BODY.PEEK[] X-GM-LABELS)', 13 | 'a0054 UID FETCH 39468 BODY.PEEK[]' => 14 | 'a0054 UID FETCH 39468 (BODY.PEEK[] X-GM-LABELS)' => 15 | 'a0054 INVALID COMMAND' => 'a0054 INVALID COMMAND', 16 | }; 17 | 18 | while (($key, $value) = each %$data) { 19 | subtest 'get_label transform' => sub { 20 | is(Net::Gmail::IMAP::Label::Proxy::get_label($key), $value, 'correct fetch'); 21 | }; 22 | } 23 | 24 | done_testing; 25 | -------------------------------------------------------------------------------- /t/02_put_label.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use Test::More; 4 | use utf8; 5 | 6 | BEGIN { use_ok( 'Net::Gmail::IMAP::Label::Proxy' ); } 7 | require_ok( 'Net::Gmail::IMAP::Label::Proxy' ); 8 | my $data = { 9 | q/* 1 FETCH (X-GM-LABELS ("\\\\Important" "multi word" "\\\\Starred" "complex label") UID 33126 RFC822.SIZE 3936 INTERNALDATE "02-Aug-2012 14:02:53 +0000" FLAGS (\Answered Old \Flagged \Seen) BODY[HEADER.FIELDS (DATE FROM SUBJECT TO CC MESSAGE-ID REFERENCES CONTENT-TYPE CONTENT-DESCRIPTION IN-REPLY-TO REPLY-TO LINES LIST-POST X-LABEL)] {405}/ => 10 | q/* 1 FETCH (UID 33126 RFC822.SIZE 3936 INTERNALDATE "02-Aug-2012 14:02:53 +0000" FLAGS (\Answered Old \Flagged \Seen) BODY[HEADER.FIELDS (DATE FROM SUBJECT TO CC MESSAGE-ID REFERENCES CONTENT-TYPE CONTENT-DESCRIPTION IN-REPLY-TO REPLY-TO LINES LIST-POST X-LABEL)] {444}/. 11 | Net::Gmail::IMAP::Label::Proxy::LINESEP. 12 | q/X-Label: "multi word" "complex label"/, 13 | q/* 296 FETCH (X-GM-LABELS (simple) UID 39461 RFC822.SIZE 8129 INTERNALDATE "07-Dec-2012 04:15:03 +0000" FLAGS (\Seen) BODY[HEADER.FIELDS (DATE FROM SUBJECT TO CC MESSAGE-ID REFERENCES CONTENT-TYPE CONTENT-DESCRIPTION IN-REPLY-TO REPLY-TO LINES LIST-POST X-LABEL)] {462}/ => 14 | q/* 296 FETCH (UID 39461 RFC822.SIZE 8129 INTERNALDATE "07-Dec-2012 04:15:03 +0000" FLAGS (\Seen) BODY[HEADER.FIELDS (DATE FROM SUBJECT TO CC MESSAGE-ID REFERENCES CONTENT-TYPE CONTENT-DESCRIPTION IN-REPLY-TO REPLY-TO LINES LIST-POST X-LABEL)] {479}/. 15 | Net::Gmail::IMAP::Label::Proxy::LINESEP. 16 | q/X-Label: simple/, 17 | q/* 299 FETCH (X-GM-LABELS (simple) UID 39466 BODY[] {10572}/ => 18 | q/* 299 FETCH (UID 39466 BODY[] {10589}/. 19 | Net::Gmail::IMAP::Label::Proxy::LINESEP. 20 | q/X-Label: simple/, 21 | q/* 213 FETCH (X-GM-LABELS ("\\\\Important") UID 38141 RFC822.SIZE 18747 INTERNALDATE "13-Nov-2012 15:54:38 +0000" FLAGS (Old \Seen) BODY[HEADER.FIELDS (DATE FROM SUBJECT TO CC MESSAGE-ID REFERENCES CONTENT-TYPE CONTENT-DESCRIPTION IN-REPLY-TO REPLY-TO LINES LIST-POST X-LABEL)] {421}/ => 22 | q/* 213 FETCH (UID 38141 RFC822.SIZE 18747 INTERNALDATE "13-Nov-2012 15:54:38 +0000" FLAGS (Old \Seen) BODY[HEADER.FIELDS (DATE FROM SUBJECT TO CC MESSAGE-ID REFERENCES CONTENT-TYPE CONTENT-DESCRIPTION IN-REPLY-TO REPLY-TO LINES LIST-POST X-LABEL)] {421}/, 23 | q/* 213 FETCH (X-GM-LABELS ("\\\\Important" "\\\\Starred") UID 38141 RFC822.SIZE 18747 INTERNALDATE "13-Nov-2012 15:54:38 +0000" FLAGS (Old \Seen) BODY[HEADER.FIELDS (DATE FROM SUBJECT TO CC MESSAGE-ID REFERENCES CONTENT-TYPE CONTENT-DESCRIPTION IN-REPLY-TO REPLY-TO LINES LIST-POST X-LABEL)] {421}/ => 24 | q/* 213 FETCH (UID 38141 RFC822.SIZE 18747 INTERNALDATE "13-Nov-2012 15:54:38 +0000" FLAGS (Old \Seen) BODY[HEADER.FIELDS (DATE FROM SUBJECT TO CC MESSAGE-ID REFERENCES CONTENT-TYPE CONTENT-DESCRIPTION IN-REPLY-TO REPLY-TO LINES LIST-POST X-LABEL)] {421}/, 25 | q/* 2093 FETCH (X-GM-LABELS ("\\\\Important" "multi words" "&,wglbwCwJaEAsP8JJW,+NQ- &JTslASU7-" "\\\\Starred") UID 2093 BODY[] {28208}/ => 26 | q/* 2093 FETCH (UID 2093 BODY[] {28267}/. 27 | Net::Gmail::IMAP::Label::Proxy::LINESEP. 28 | q/X-Label: "multi words" "（╯°□°）╯︵ ┻━┻"/, 29 | q/* 3928 FETCH (X-GM-LABELS ("its &- it's") UID 3928 RFC822.SIZE 409403 INTERNALDATE "22-Jun-2012 20:10:05 +0000" FLAGS (Old \Seen) BODY[HEADER.FIELDS (DATE FROM SUBJECT TO CC MESSAGE-ID REFERENCES CONTENT-TYPE CONTENT-DESCRIPTION IN-REPLY-TO REPLY-TO LINES LIST-POST X-LABEL)] {486}/ => 30 | q/* 3928 FETCH (UID 3928 RFC822.SIZE 409403 INTERNALDATE "22-Jun-2012 20:10:05 +0000" FLAGS (Old \Seen) BODY[HEADER.FIELDS (DATE FROM SUBJECT TO CC MESSAGE-ID REFERENCES CONTENT-TYPE CONTENT-DESCRIPTION IN-REPLY-TO REPLY-TO LINES LIST-POST X-LABEL)] {509}/. 31 | Net::Gmail::IMAP::Label::Proxy::LINESEP. 32 | q/X-Label: "its & it's"/, 33 | q/* 537 FETCH (X-GM-LABELS ("parens ()") UID 1471 BODY[] {873}/ => 34 | q/* 537 FETCH (UID 1471 BODY[] {895}/. 35 | Net::Gmail::IMAP::Label::Proxy::LINESEP. 36 | q/X-Label: "parens ()"/, 37 | q/* 14496 FETCH (X-GM-LABELS ("\\\\Sent" "(" "()") UID 25337 BODY[] {650}/ => 38 | q/* 14496 FETCH (UID 25337 BODY[] {669}/. 39 | Net::Gmail::IMAP::Label::Proxy::LINESEP. 40 | q/X-Label: "(" "()"/, 41 | q/* 537 FETCH (X-GM-LABELS ("zzzz\"" "\\\\Sent" "zzz)" "zz(") UID 1471 BODY[] {873}/ => 42 | q/* 537 FETCH (UID 1471 BODY[] {905}/. 43 | Net::Gmail::IMAP::Label::Proxy::LINESEP. 44 | q/X-Label: "zzzz\"" "zzz)" "zz("/, 45 | q/* 138 FETCH (X-GM-LABELS ("\\\\Important" "\\\\Sent" "\\\\") UID 36833 BODY[] {841}/ => 46 | q/* 138 FETCH (UID 36833 BODY[] {856}/. 47 | Net::Gmail::IMAP::Label::Proxy::LINESEP. 48 | q/X-Label: "\\\\"/, 49 | q/* 286 FETCH (X-GM-LABELS (Test ")") UID 39560 BODY[] {44795}/ => 50 | q/* 286 FETCH (UID 39560 BODY[] {44814}/. 51 | Net::Gmail::IMAP::Label::Proxy::LINESEP. 52 | q/X-Label: Test ")"/, 53 | q/* 283 FETCH (X-GM-LABELS (&- Test) UID 39557 BODY[] {10730}/ => 54 | q/* 283 FETCH (UID 39557 BODY[] {10747}/. 55 | Net::Gmail::IMAP::Label::Proxy::LINESEP. 56 | q/X-Label: & Test/, 57 | q/* 286 FETCH (X-GM-LABELS () UID 39560 BODY[] {44795}/ => 58 | # empty labels should not generate X-Label 59 | q/* 286 FETCH (UID 39560 BODY[] {44795}/, 60 | '* 3928 NOT A RESPONSE' => '* 3928 NOT A RESPONSE', # Not a FETCH 61 | q/* 286 FETCH (X-GM-LABELS (Broken ")""") UID 39560 BODY[] {44795}/ => 62 | # this will not parse because two strings can not be adjacent 63 | q/* 286 FETCH (X-GM-LABELS (Broken ")""") UID 39560 BODY[] {44795}/, 64 | }; 65 | 66 | while (($key, $value) = each %$data) { 67 | subtest 'put_label transform' => sub { 68 | is(Net::Gmail::IMAP::Label::Proxy::put_label($key), $value, 'correct response'); 69 | }; 70 | } 71 | 72 | 73 | done_testing; 74 | --------------------------------------------------------------------------------