AnyEvent-MSN

 view release on metacpan or  search on metacpan

examples/client.pl  view on Meta::CPAN

                $msn->add_contact($1);
            }
            when (/^remove (.+)$/) {
                warn 'Removing ' . $1;
                $msn->remove_contact($1);
            }
            when (/^circle (.+)$/) {
                $msn->create_group_chat;

=fdas
PUT 35 260
Routing: 1.0
From: 1:testmsnpsharp@live.cn;epid={ad9d9247-9181-4c57-8388-248304e153d3}
To: 10:00000000-0000-0000-0000-000000000000@live.com

Reliability: 1.0

Publication: 1.0
Content-Length: 0
Content-Type: application/multiparty+xml
Uri: /circle

lib/AnyEvent/MSN.pm  view on Meta::CPAN

                # Get ready to read data from server
                $s->handle->push_read(
                    'AnyEvent::MSN::Protocol' => sub {
                        my ($cmd, $tid, @data) = @_;
                        my $method = $s->can('_handle_packet_' . lc($cmd));
                        $method ||= sub {
                            $s->_trigger_error(
                                            'Unhandled command type: ' . $cmd,
                                            0);
                        };
                        if ($cmd =~ m[^(?:GCF|MSG|NFY|NOT|SDG|UBX|PUT)$])
                        {    # payload types
                            $s->handle->unshift_read(
                                chunk => $data[-1] // $tid,    # GFC:0, MSG:2
                                sub {
                                    my ($_h, $_c) = @_;
                                    $s->$method(
                                        $tid, @data,
                                        $cmd =~ m[GCF] ? $s->_parse_xml($_c)
                                        : $cmd =~ m[(?:MSG|NFY|SDG)] ?
                                            AnyEvent::MSN::Protocol::__parse_msn_headers(

lib/AnyEvent/MSN.pm  view on Meta::CPAN

    my ($s, $type, $len, $headers, $data) = @_;

=begin comment
        use Data::Printer;
        dd $type, $len, $headers, $data;
        dd $s->_parse_xml($data);
=cut
    given ($headers->{Uri}) {
        when ('/user') {
            given ($type) {
                when ('PUT') {
                    my $xml = $s->_parse_xml($data);
                    if ((!defined $headers->{By})
                        && $headers->{From} eq '1:' . $s->passport)
                    {    # Without guid
                        $s->set_status($s->status)
                            ;    # Not fully logged in until sent
                        $s->_set_connected();
                        $s->_trigger_connect;
                    }
                    else {

lib/AnyEvent/MSN.pm  view on Meta::CPAN

        }
        default {...}
    }
}
sub _handle_packet_not { my $s = shift; }
sub _handle_packet_out { my $s = shift; }

sub _handle_packet_put {
    my $s = shift;

    # ACK for our PUT packets
}

sub _handle_packet_qng {
    my ($s, $next) = @_;

    # PONG in reply to our PNG
    $s->_set_ping_timer(AE::timer $next, $next, sub { $s->send('PNG') });
}

sub _handle_packet_qry {

lib/AnyEvent/MSN.pm  view on Meta::CPAN

        . '<sep n="IM"><Capabilities>2953838624:132096</Capabilities></sep>'
        . '</user>', __html_escape($s->friendly_name),
        __html_escape($s->personal_message),
        $status,
        __html_escape($s->location), $status, $s->guid;
    my $out
        = sprintf
        qq[To: 1:%s\r\nRouting: 1.0\r\nFrom: 1:%s;epid=%s\r\n\r\nStream: 1\r\nFlags: ACK\r\nReliability: 1.0\r\n\r\nContent-Length: %d\r\nContent-Type: application/user+xml\r\nPublication: 1.0\r\nUri: /user\r\n\r\n%s],
        $s->passport,
        $s->passport, $s->guid, length($body), $body;
    $s->send("PUT %d %d\r\n%s", $s->tid, length($out), $out);
};

# Testing/Incomplete stuff
sub create_group_chat {
    my $s    = shift;
    my $body = '';      # For now.
    my $out
        = sprintf
        qq[To: 10:00000000-0000-0000-0000-000000000000\@live.com\r\nRouting: 1.0\r\nFrom: 1:%s;epid=%s\r\n\r\nStream: 1\r\nFlags: ACK\r\nReliability: 1.0\r\n\r\nContent-Length: %d\r\nContent-Type: application/multiparty+xml\r\nPublication: 1.0\r\nUri...
        $s->passport, $s->guid, length($body), $body;
    $s->send("PUT %d %d\r\n%s", $s->tid, length($out), $out);
}

# Random private methods
sub _parse_xml {
    my ($s, $data) = @_;
    state $xml_twig //= XML::Twig->new();
    my $xml = {};
    use Carp;

=begin comment Carp::confess('...') if ! length $data ;

lib/AnyEvent/MSN/Protocol.pm  view on Meta::CPAN

        $s->(split qr[\s+], $line);    # my ($cmd, $tid, @data)
        $handle->push_read(__PACKAGE__, $s);    # Re-queue
        return 1                                # But remove this one
        }
}

sub anyevent_write_type {    # XXX - Currently... not... right.
    my ($handle, @args) = @_;
    my $out = sprintf shift(@args), grep {defined} @args;
    AnyEvent::MSN::DEBUG() && warn 'O: ' . $out;
    return $out . ($out =~ m[^(QRY|UUX|ADL|PUT|SDG)] ? '' : "\015\012");
}

sub __parse_msn_headers {
    state $hp //= sub {
        map { split qr[\s*:\s*], $_, 2 }
            split qr[\015?\012],
            shift;
    };
    my ($h1, $h2, $h3, $body) = split qr[\015?\012\015?\012], shift, 4;
    ({map { $hp->($_) }