[ViewVC] Diff of: cvs/Net-Knuddels/Net/Knuddels.pm

Comparing Net-Knuddels/Net/Knuddels.pm (file contents):
Revision 1.22 by elmex, Fri Jan 14 23:17:13 2005 UTC vs.
Revision 1.23 by elmex, Fri Jan 21 17:25:18 2005 UTC

 sub handle_room {
   my ($self, $room) = @_;
   if ($room eq "-") {
-    if (defined $self->{only_room}) {
+    if (scalar (keys %{$self->{room}}) == 1) {
-      return $self->{only_room};
+      return (keys %{$self->{room}})[0];
     } else {
       warn "Couldn't assign '-' room to a room!";
-      return '-';
+      return '#nosuchroom';
     }
   } else {
     return $room;
   }
 }
    syswrite $fh, "\0";
    $self->register ("(" => sub {
       $self->{login_challenge} = $_[0];
       $self->{login_room}      = $_[1];
-      $self->{proto}->feed_event ("login");
+      $self->{proto}->feed_event (login => $_[1]);
    });
    $self->register (k => sub {
       my @str = map { s/[\356\343]//; $_ } @_;
       my @out;
       push @out, split /#/, $_ for @str;
       $self->{proto}->feed_event (dialog => \@out);
    });
    $self->register (t => sub {
       my $src = $_[0];
       if ($src eq '-') {
         $_[2] = $self->{knuddels_nick} . " " . $_[2];
       } else {
         $_[2] = $src . " " . $_[2];
       }
       $self->{proto}->feed_event (action_room => $self->handle_room ($_[1]), $_[2]);
    });
    $self->register (r => sub {
       my $src = $_[0];
       $src = $self->{knuddels_nick} if $src eq "-";
       $self->{proto}->feed_event (msg_priv => $self->handle_room ($_[2]), $src, $_[1], $_[3]);
    });
    $self->register (e => sub {
       $self->{proto}->feed_event (msg_room => $self->handle_room ($_[1]), $_[0], $_[2]);
    });
+   $self->register (l => sub {
+   });
    $self->register (l => sub {
       my $room = $self->handle_room ($_[0]);
       return if $room eq "-"; # things that shouln't happen
       my $user = {
         $u = { name => $username };
       }
       $self->{proto}->feed_event (part_room => $room, $u);
    });
+   $self->register (b => sub {
+      my @arg = @_;
+      my $cc = {};
+      $self->{knuddels_rooms}->{$cc->{name}} = {};
+      my $last = $cc;
+      my $chan_cnt = 2;
+      while (@arg) {
+        $cc->{name} = shift @arg;
+        if ($cc->{name} =~ s/\cJ(\d+)$//) {
+          $cc->{user_count} = $1;
+        }
+        if ($cc->{name} =~ m/^"/) {
+          $cc->{name} = "$last->{name} $chan_cnt";
+          $chan_cnt++;
+        } else {
+          $last = $cc;
+          $chan_cnt = 2;
+        }
+        $cc->{flag1} = shift @arg;
+        $cc->{flag2} = shift @arg;
+        my $i = 0;
+        for (my $a = shift @arg; $a ne "-"; $a = shift @arg) {
+          if ($i == 0) {
+            $cc->{picture} = $a;
+            $cc->{full_flag} = 1 if $cc->{picture} =~ m/full/i;
+          }
+          $i++;
+        }
+        $self->{knuddels_rooms}->{$cc->{name}} = $cc;
+        $cc = {};
+      }
+      $self->{proto}->feed_event (room_list => $self->{knuddels_rooms});
+   });
+   $self->register (d => sub {
+      my $room = $self->handle_room ($_[0]);
+      delete $self->{room}->{lc $room};
+      $self->{room}->{lc $_[1]} = { name => $_[1] };
+      $self->{proto}->feed_event (change_room => $room, $_[1]);
+   });
+   $self->register ('6' => sub {
+      # i have no exact clue what this message does,
+      # but java-code seems to say i should do this:
+      warn "*********************** SIX MESSAGE GOT!!! CHECK PROTOCOL FOR OCCURENCE!!";
+      # delete $self->{room}->{lc ($self->handle_room ($_[0]))};
+   });
    $self->register (a => sub {
-      # the only_room stuff is from java-code, which has naughy semantics
-      if (not defined $self->{only_room}) {
-        $self->{only_room} = $_[0];
-      } else {
-        $self->{only_room} = "-";
-      }
       $self->{my_nick} = $_[1]; # i'm really _not_ shure about this
       my $ri = $self->{room}->{lc $_[0]} = {
+        name => $_[0],
         picture => $_[7],
       };
       $self->{proto}->feed_event (room_info => $_[0], $ri);
    });
    $self->register (u => sub {
       my $room = shift;
       my $rl = $self->{user_lists}->{lc $room} = {};
       my $cur_u = {};
    my ($self, $url, $unknown) = @_;
    $self->command ("t", "V8.6a", $url || "http://www.knuddels.de/applet.html?v=86a&c=0", $unknown || 3);
 }
-=item $client->set_nick ($room, $nick, $password)
+=item $client->enter_room ($room, $nick, $password)
-Registers the nick with the given password.
+Enters a room C<$room> with C<$nick> and C<$password>.
+(for joining multiple rooms call this multiple times)
-=cut
+NOTE: i won't allow joins to multiple rooms with different nick/password's,
+the java client reacted very confused.. don't know whether the server supports this.
-sub set_nick {
+=cut
+sub enter_room {
    my ($self, $room, $nick, $password) = @_;
+   if (defined $self->{knuddels_nick} and $self->{knuddels_nick} ne $nick) {
+     return # i don't think knuddels-server will be happy if
+            # we join multiple rooms on multiple accounts over 1 connection
+   }
    exists $self->{login_challenge} or Carp::croak "set_nick can only be called after a login event";
    $self->{knuddels_nick} = $nick;
+   print "ENTER: $room\n";
    $self->command ("n", $room, $nick, Net::Knuddels::hash_pw $self->{login_challenge}, $password);
 }
 =item $client->send_whois ($nick)
 =cut
 sub send_room_msg {
   my ($self, $room, $message) = @_;
-  print "SEND ROOM: $room : $message\n";
+  print "SEND ROOM:$room\: $message\n";
   $self->command ("e", $room, $message);
 }
 =item $client->send_priv_msg ($nick, $room, $message)
 =cut
 sub send_priv_msg {
   my ($self, $nick, $room, $message) = @_;
-  print "SEND ROOM: $room : /p $nick:$message\n";
+  print "SEND PRIV:$room: /p $nick:$message\n";
   $self->command ("e", $room, "/p $nick:$message");
+}
+=item $client->send_join_room ($oldroom, $room)
+  Sends the server a join command for C<$room>. This
+  will result in a room change from C<$oldroom> to C<$room>.
+=cut
+sub send_join_room {
+  my ($self, $old_room, $room) = @_;
+  print "JOIN ROOM: #room : /go $room\n";
+  $self->command ("e", $old_room, "/go $room");
+}
+=item $client->send_exit_room ($room)
+  Exits C<$room> completly. (can be seen as counter method for C<enter_room ()>);
+=cut
+sub send_exit_room {
+  my ($self, $room) = @_;
+  print "EXIT EOORM: $room \n";
+  $self->command ("w", $room, "\0", "\0");
+  delete $self->{room}->{lc $room};
 }
 =item $client->register ($type => $cb)
 See L<Net::Knuddels::Protocol::register>. The following extra events will

Diff Legend

-–
+Removed lines
-+
+Added lines
-<
+Changed lines
->
+Changed lines

Comparing Net-Knuddels/Net/Knuddels.pm (file contents): Revision 1.22 by elmex, Fri Jan 14 23:17:13 2005 UTC vs. Revision 1.23 by elmex, Fri Jan 21 17:25:18 2005 UTC

Diff Legend

Comparing Net-Knuddels/Net/Knuddels.pm (file contents):
Revision 1.22 by elmex, Fri Jan 14 23:17:13 2005 UTC vs.
Revision 1.23 by elmex, Fri Jan 21 17:25:18 2005 UTC