view release on metacpan or  search on metacpan

lib/POE/Component/YahooMessenger.pm  view on Meta::CPAN

sub _handle_common {
    $_[KERNEL]->yield(notify => $_[ARG0]->name, $_[ARG0]);
}

sub challenge_start {
    my($kernel, $heap, $event) = @_[KERNEL, HEAP, ARG0];

    # calculate CRAM
    my $cram = Net::YahooMessenger::CRAM->new;
    $cram->set_id($heap->{id});
    $cram->set_password($heap->{password});
    $cram->set_challenge_string($event->challenge_string);
    my($response_password, $response_crypt) = $cram->get_response_strings;

    $heap->{sock}->event(InputEvent => 'handle_event');
    $heap->{sock}->put(
	POE::Component::YahooMessenger::Event->new(
	    'challenge_response', 0, {
		my_id  => $heap->{id},
		crypt_salt => $response_password,
		crypted_response => $response_crypt,
		login_nickname  => 1,
		id => $heap->{id},
	    },
	),
    );
    $kernel->yield(notify => $event->name, $event);
}

sub receive_buddy_list {
    my($kernel, $heap, $event) = @_[KERNEL, HEAP, ARG0];
    my $buddy_list = $event->buddy_list;
    while ($buddy_list =~ /([^:]+):([^\x0a]+)\x0a/g) {
	my $group = $1;
	my @buddies = split /,/, $2;
	$heap->{buddies}->{$_} = $group for @buddies;
    }
    $kernel->yield(notify => $event->name, $event);
}

sub goes_online {
    my($kernel, $heap, $event) = @_[KERNEL, HEAP, ARG0];
    my $number = $event->number_of_online_buddies;
    $number = 1 unless defined $number;

    # XXX status message is optional
    my $status_num;
    for my $num (0..$number-1) {
	$heap->{online}->{$event->buddy_id($num)} = 1;
	my $status_code = $event->status_code($num);
	my $status_message;
	if ($status_code == 99) {
	    $status_message = $event->status_message($status_num);
	    $status_num++;
	}
	my $goes_online = POE::Component::YahooMessenger::Event->new(
	    'goes_online', 0, {
		buddy_id => $event->buddy_id($num),
		status_code => $status_code,
		status_message => $status_message,
		busy_code => $event->busy_code($num),
	    },
	);
	$kernel->yield(notify => $goes_online->name, $goes_online);
    }
}

sub goes_offline {
    my($kernel, $heap, $event) = @_[KERNEL, HEAP, ARG0];
    delete $heap->{online}->{$event->buddy_id};
    $kernel->yield(notify => $event->name, $event);
}

sub receive_message {
    my($kernel, $heap, $event) = @_[KERNEL, HEAP, ARG0];
    my $code = $event->status_code;
    unless (defined $code && $code == 99) {
	$kernel->yield(notify => $event->name, $event);	
    }
}

sub send_message {
    my($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
    my $option = $heap->{buddies}->{$args->{to}}
	? $Options->{to_buddies} : $Options->{to_non_buddies};
    $heap->{sock}->put(
	POE::Component::YahooMessenger::Event->new(
	    'send_message', $option, {
		from => $heap->{id},
		to   => $args->{to},
		message => $args->{message},
	    },
	),
    );
}

sub change_my_status {
    my($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
    $heap->{sock}->put(
	POE::Component::YahooMessenger::Event->new(
	    'change_status', 0, {
		status_code => 99, # XXX custom status
		busy_code => $args->{busy} || 0,
		status_message => $args->{message},
	    },
	),
    );
}

sub buddies {
    my($kernel, $heap, $sender, $reply) = @_[KERNEL, HEAP, SENDER, ARG0];
    $kernel->post($sender => $reply => $heap->{buddies});
}

sub add_buddy {
    my($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
    $heap->{sock}->put(
	POE::Component::YahooMessenger::Event->new(
	    'add_buddy', 0, {
		id       => $heap->{id},
		buddy_id => $args->{buddy_id},
		group    => $args->{group},
		message  => $args->{message},
	    },
	),
    );
}

sub delete_buddy {
    my($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0];
    $heap->{sock}->put(
	POE::Component::YahooMessenger::Event->new(
	    'delete_buddy', 0, {
		id           => $heap->{id},
		buddy_id     => $args->{buddy_id},
		group        => $args->{group},
	    },
	),
    );
}

1;
__END__

=head1 NAME

POE::Component::YahooMessenger - POE component for Yahoo! Messenger

=head1 SYNOPSIS

  use POE qw(Component::YahooMessenger);

  # spawn YM session
  POE::Component::YahooMessenger->spawn(Alias => 'ym');

  # register your session for callbacks
  $kernel->post(ym => 'register');

  # tell YM how to connect
  $kernel->post(ym => connect => {
      id       => 'your_id',
      password => 'xxxxxxx',
  });

  # associate this callback with 'ym_goes_online'
  sub goes_online {
      my $event = $_[ARG0];
      printf "buddy %s goes online\n", $event->buddy_id;
  }

  # send message
  $kernel->post(ym => send_message => {
      to => $buddy_id,
      message => "Hello World",
  });

  # change your status
  $kernel->post(ym => change_my_status => {
      busy => 0, # 0 = not busy
      message => "going for lunch now!",
  });

  # retrieve your buddies list
  $kernel->post(ym => buddies => 'retrieve_buddies');
  sub retrieve_buddies {
      my $buddies = $_[ARG0];
      for my $buddy_id (keys %$buddies) {
	  printf "%s (group: %s)\n", $buddy_id, $buddies->{$buddy_id};
      }
  }

  $poe_kernel->run();

=head1 DESCRIPTION

POE::Component::YahooMessenger is a POE component to connect Yahoo!
Messener. This module ripoffs a lot of code from Net::YahooMessenger
for protocol implementations.

API is intentionally made similar to that of PoCo::IRC.

=head1 EVENTS

TBD.

=head1 CAVEATS

B<This is ALPHA SOFTWARE>: There maybe some bugs. API might change.

=head1 AUTHOR

Tatsuhiko Miyagawa E<lt>miyagawa@bulknews.netE<gt>

YahooMessenger protocol implementation is based on Net::YahooMessenger
by Hiroyuki Oyama E<lt>oyama[cpan.orgE<gt>.

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

=head1 SEE ALSO

L<POE>, L<POE::Component::IRC>, L<Net::YahooMessenger>, http://ymca.infoware.ne.jp/

=cut