Dancer-SearchApp

 view release on metacpan or  search on metacpan

lib/Mail/Email/IMAP.pm  view on Meta::CPAN

package Mail::Email::IMAP;
use strict;
use MIME::WordDecoder;
use MIME::Base64;
use MIME::QuotedPrint;
use Scalar::Util qw(weaken);
use Encode qw(decode);
use Text::Markdown ();
use HTTP::Date qw( time2isoz );
use Time::Piece;
#use 5.016; # for fc

use Mail::Clean 'clean_subject';
use vars qw($VERSION);
$VERSION = '0.06';

sub new {
    my $class = shift;
    bless { 
        text_formatter => Text::Markdown->new(),
        @_,
    } => $class;
};

sub from_imap_client {
    my ($package, $conn, $uid, %info) = @_;
    #weaken $conn;
    
    my $dt = $conn->date( $uid );
    
    my $timestamp;
    if( $dt ) {
        $dt =~ s!\s*\(([A-Z]+.*?)\)\s*$!!; # strip clear name of timezone at end
        $dt =~ s!\s*$!!; # Strip whitespace at end
        $dt =~ s!\bUTC$!GMT!; # "UTC" -> "GMT", ah, well...
        
        # Let's be lenient about the time format:
        my $format = '%d %b %Y %H:%M:%S';
        
        if( $dt =~ /,/ ) {
            # As good citizens, they added the weekday name:
            $format = "%a, $format";

        };
        if( $dt =~ /[A-Z]+$/ ) {
            # Instead of an offset, we have the name :-/
            $format = $format . " %Z";

        } else {
            # The default, for well-formed servers, an TZ offset
            $format .= " %z";
        };
        
        if( ! eval { $timestamp = Time::Piece->strptime( $dt, $format ); 1 }) {
            die "$@:\n$format - [$dt]\n";
        };
    } else {
        $dt ||= '';
        warn "No timestamp for $uid?! [$dt]";
    };
    
    my $self = $package->new(
        %info,
        uid      => $uid,
        date     => $timestamp,
        imap     => $conn,
        body     => $conn->get_bodystructure($uid),
        envelope => $conn->get_envelope($uid),
        categories => [],
    );
    
    $self
};

sub imap() {
    $_[0]->{imap}
};

# Install our reflectors for the envelope
BEGIN {
    no strict 'refs';
    for my $acc (qw< inreplyto >) {
        *{"$acc"} = sub {
            $_[0]->{envelope}->$acc
        };
    };
    



( run in 3.119 seconds using v1.01-cache-2.11-cpan-39bf76dae61 )