view release on metacpan or  search on metacpan

script/ymsgjdump.pl  view on Meta::CPAN

    _dump($event);
}

sub _dump {
    my $event = shift;

    printf "Event name: %s\n", ( caller(1) )[3];
    printf "Event code: %d\n", $event->code;
    my $packet = $event->source;
    while ( $packet =~ /(.{1,16})/g ) {
        print join ' ',
          map { sprintf '%02x', ord $_, ( /^[\w\-_\.]$/ ? $_ : '.' ) } split //,
          $1;
        print ' ' x ( ( 16 - length($1) ) * 3 + 8 );
        print join '', map { /^[\w\-_\.]$/ ? $_ : '.'; } split //, $1;
        print "\n";
    }
}

sub Login {
    my $self  = shift;
    my $event = shift;
    my $yahoo = $event->get_connection;
    printf "[system] Friends for - %s\n", $event->from;

    my $baddy_status = join "\n", map { $_->to_string } $yahoo->buddy_list;
    print Jcode->new($baddy_status)->euc, "\n";

    _dump($event);
}

sub GoesOnline {
    my $self  = shift;
    my $event = shift;

    if ( $event->from ) {
        printf "[system] %s goes in.\n", $event->from;
        _dump($event);
    }
    else {
        print
"[system] You have been logged off as you have logged in on a different machine.\n";
        _dump($event);
        exit;
    }
}

sub GoesOffline {
    my $self  = shift;
    my $event = shift;

    printf "[system] %s goes out.\n", $event->from;

    _dump($event);
}

sub ChangeState {
    my $self  = shift;
    my $event = shift;

    my $busy_status =
        $event->busy == 1 ? '(Busy) '
      : $event->busy == 2 ? '(Sleep) '
      :                     '';

    my $message;
    if ( $event->status_code == 99 ) {
        $message = sprintf "[%s] %sTransit to '%s'\n",
          $event->from, $busy_status, $event->body;
    }
    else {
        $message = sprintf "[%s] %sTransit to '%s'\n",
          $event->from, $busy_status, STATUS_MESSAGE->[ $event->status_code ];
    }
    print Jcode->new($message)->euc;

    _dump($event);
}

sub NewFriendAlert {
    my $self  = shift;
    my $event = shift;

    my $message =
      sprintf "[system] New Friend Alert: %s added %s as a Friend.\n",
      $event->from, $event->to;
    $message .= sprintf "and also sent the following message: %s\n",
      $event->body;
    print Jcode->new($message)->euc;

    _dump($event);
}

sub ReceiveMessage {
    my $self  = shift;
    my $event = shift;

    my $body = $event->body;
    $body =~ s{</?(?:font|FACE).+?>}{}g;
    my $message = sprintf "[%s] %s\n", $event->from, $body;
    print Jcode->new($message)->euc;

    _dump($event);
}

1;

__END__