File Coverage

blib/lib/WWW/Omegle.pm

Criterion	Covered	Total	%
statement	27	109	24.7
branch	0	42	0.0
condition	0	9	0.0
subroutine	9	21	42.8
pod	7	12	58.3
total	43	193	22.2

package WWW::Omegle;

use 5.006000;
use strict;
use warnings;

use Carp qw/croak/;
use JSON;

use base qw/WWW::Mechanize/;
use HTTP::Async;
use HTTP::Request;
use HTTP::Request::Common;

our $VERSION = '0.02';

sub new {
    my ($class, %opts) = @_;

    my $chat_cb = delete $opts{on_chat};
    my $disconnect_cb = delete $opts{on_disconnect};
    my $connect_cb = delete $opts{on_connect};

    my $self = $class->SUPER::new(%opts);

    $self->{om_callbacks} = {
        chat => $chat_cb,
        connect => $connect_cb,
        disconnect => $disconnect_cb,
    };

    my $async = new HTTP::Async();
    $self->{async} = $async;

    bless $self, $class;

    return $self;
}

sub start {
    my ($self) = @_;

    my $res = $self->post("http://omegle.com/start");
    return undef unless $res->is_success;

    my $res_body = $res->content || '';
    my ($id) = $res_body =~ /"(\w+)"/;
    return undef unless $id;

    $self->{om_id} = $id;

    $self->handle_event($res);
    $self->request_next_event;

    return $id;
}

sub callback {
    my ($self, $action, @args) = @_;

    my $callback = $self->{om_callbacks}->{$action}
        or return;

    my $extra = $self->{om_callback_userdata}->{$action} || [];
    $callback->($self, @args, @$extra);
}

sub set_callback {
    my ($self, $action, $cb, @extra) = @_;

    $self->{om_callback_userdata}->{$action} = \@extra;
    $self->{om_callbacks}->{$action} = $cb;
}

# process a HTTP::Response from /events. parse JSON and dispatch to callbacks
sub handle_event {
    my ($self, $res) = @_;

    unless ($res->is_success) {
        $self->callback('error', $res->status_line);
        warn "HTTP error: " . $res->status_line;
        return;
    }

    return undef unless $res->content;

    unless ($res->content =~ /^\[/) {
        if ($res->content eq 'win') {
            # yay, message delivered OK
            return;
        } elsif ($res->content =~ /^"/) { # " ){  # emacs :(
            # got id
            return;
        } else {
            # not JSON array of events
            $self->callback(error => "Got invalid JSON: " . $res->content);
            return;
        }
    }

    my $json = new JSON;
    my $events = $json->decode($res->content)
        or return undef;

    return undef unless ref $events && ref $events eq 'ARRAY';

    foreach my $evt (@$events) {
        my $evt_name = $evt->[0]
            or next;
        if ($evt_name eq 'connected') {
            $self->callback('connect');
        } elsif ($evt_name eq 'gotMessage') {
            $self->callback('chat', $evt->[1]);
        } elsif ($evt_name eq 'strangerDisconnected') {
            $self->callback('disconnect');
            delete $self->{om_id};
        } elsif ($evt_name eq 'waiting') {

        } else {
            warn "Got unknown omegle event: $evt_name";
        }
    }

    $self->callback('event_handled', 1);

    return 1;
}

# event loop, currently runs forever.
sub run_event_loop {
    my ($self) = @_;

    my $done;
    while (! $done) {
        my $res = $self->wait_next_event;
        next unless $res;

        $self->handle_event($res);
        $self->request_next_event;
    }
}

# block and wait for next omegle event
sub wait_next_event {
    my ($self, $wait_for) = @_;
    $wait_for ||= 0.5;
    return $self->{async}->wait_for_next_response($wait_for);
}

# let async http worker do some work, and flush event queue
sub poke {
    my $self = shift;

    $self->{async}->poke;
    $self->flush_events;
}

# process all http responses in the queue
sub flush_events {
    my $self = shift;

    my $got_events = 0;

    while ($self->{async}->not_empty) {
        if (my $response = $self->{async}->next_response) {
            $self->handle_event($response);
            $got_events = 1;
        } else {
            last;
        }
    }

    # got some events, should ask for more
    $self->request_next_event if $got_events;
}

# post an asynchronous http request asking omegle for the next event.
# this may take a long time to complete
sub request_next_event {
    my ($self) = @_;

    return undef unless $self->{om_id};
    $self->{async}->add(POST "http://omegle.com/events", [ id => $self->{om_id} ]);
}

sub say {
    my ($self, $what) = @_;

    return undef unless $self->{om_id};
    $self->{async}->add(POST "http://omegle.com/send", [ id => $self->{om_id}, msg => $what ]);
}

sub disconnect {
    my ($self) = @_;

    return undef unless $self->{om_id};
    $self->{async}->add(POST "http://omegle.com/disconnect", [ id => $self->{om_id} ]);
}

1;


__END__