view release on metacpan or  search on metacpan

lib/App/Twimap/Tweet.pm  view on Meta::CPAN

    my $subject_offset = 0;
    my $text_offset    = 0;

    my $oembed = '';

    if ( $tweet->{entities} && $tweet->{entities}->{urls} ) {
        foreach my $entity ( @{ $tweet->{entities}->{urls} } ) {

            my $expanded_url = $entity->{expanded_url} || $entity->{url};
            next unless $expanded_url;
            $expanded_url = $self->expand_url($expanded_url)
                if $self->expand_urls;
            substr(
                $subject,
                $entity->{indices}->[0] + $subject_offset,
                $entity->{indices}->[1] - $entity->{indices}->[0]
            ) = $expanded_url;
            $subject_offset
                += length($expanded_url) - length( $entity->{url} );

            my $href = qq{<a href="$expanded_url">$expanded_url</a>};
            substr(
                $text,
                $entity->{indices}->[0] + $text_offset,
                $entity->{indices}->[1] - $entity->{indices}->[0]
            ) = $href;
            $text_offset += length($href) - length( $entity->{url} );

            if ( $self->oembed_urls ) {
                $oembed = $self->oembed_url($expanded_url) || '';
            }
        }
    }

    $subject =~ s{\n}{ }g;
    local ($Text::Wrap::break)   = qr/\s/;
    local ($Text::Wrap::columns) = 72;
    local ($Text::Wrap::huge)    = 'overflow';

    my $body_text = wrap( '', '', $subject ) . "\n\n$url";

    my $body_html
        = qq{$text\n<br/><br/>\n$oembed<br/><br/>\n\n<a href="$url">$url</a>};

    my $from = Email::Address->new( $name, "$screen_name\@twitter",
        "($screen_name)" );

    my @headers = (
        From         => $from,
        Subject      => decode_entities($subject),
        Date         => $date,
        'Message-Id' => "<$tid\@twitter>",
    );
    push @headers, 'In-Reply-To' => $in_reply_to if $in_reply_to;

    my @parts = (
        Email::MIME->create(
            attributes => {
                content_type => "text/plain",
                disposition  => "inline",
                charset      => "utf-8",

            },
            header_str => [ Date => $date ],
            body       => $body_text,
        ),
        Email::MIME->create(
            attributes => {
                content_type => "text/html",
                disposition  => "inline",
                charset      => "utf-8",

            },
            header_str => [ Date => $date ],
            body       => $body_html,
        ),
    );

    my $email = Email::MIME->create(
        attributes => {
            boundary     => '1317546824.2C8b2BC51.4794',
            content_type => "multipart/alternative",
            charset      => "utf-8",
        },
        header_str => \@headers,
        parts      => [@parts],
    );

    return $email;
}

sub expand_url {
    my ( $self, $url ) = @_;
    my $ua = LWP::UserAgent->new(
        env_proxy             => 1,
        timeout               => 5,
        max_size              => 2048,
        agent                 => "Twimap",
        requests_redirectable => [],
    );
    my $res = $ua->get($url);
    return $url unless $res->is_redirect;
    my $location = $res->header('Location');
    return $url unless defined $location;

    unless ( $location =~ /^http/ ) {
        my $uri = URI::WithBase->new( $location, $url )->abs;
        return $self->expand_url($uri);
    }
    return $self->expand_url($location);
}

sub oembed_url {
    my ( $self, $url ) = @_;

    my $consumer = Web::oEmbed::Common->new();
    $consumer->agent->timeout(5);

    #$consumer->set_embedly_api_key('0123ABCD0123ABCD0123ABCD');
    my $response = $consumer->embed($url);
    return $response->render if ($response);
}

__PACKAGE__->meta->make_immutable;

=head1 NAME

App::Twimap::Tweet - Represent a Tweet and convert to email

=head1 AUTHOR

Leon Brocard <acme@astray.com>.

=head1 COPYRIGHT

Copyright (C) 2011, Leon Brocard

=head1 LICENSE

This module is free software; you can redistribute it or modify it
under the same terms as Perl itself.