| … | |
… | |
| 277 | } |
277 | } |
| 278 | |
278 | |
| 279 | return $user; |
279 | return $user; |
| 280 | } |
280 | } |
| 281 | |
281 | |
|
|
282 | sub del1 { |
|
|
283 | my ($str) = @_; |
|
|
284 | my $s = substr ($$str, 0, 1); |
|
|
285 | $$str = substr ($$str, 1); |
|
|
286 | $s |
|
|
287 | } |
|
|
288 | |
|
|
289 | sub del2 { |
|
|
290 | my ($str) = @_; |
|
|
291 | my $s = substr ($$str, 0, 2); |
|
|
292 | $$str = substr ($$str, 2); |
|
|
293 | $s |
|
|
294 | } |
|
|
295 | |
|
|
296 | sub todelim { |
|
|
297 | my ($str) = @_; |
|
|
298 | $$str =~ s/^(.*?)\365//; |
|
|
299 | $1; |
|
|
300 | } |
|
|
301 | |
|
|
302 | sub chk_flag { |
|
|
303 | my ($str) = @_; |
|
|
304 | if ($$str =~ s/^\343//) { |
|
|
305 | return 1; |
|
|
306 | } |
|
|
307 | return 0; |
|
|
308 | } |
|
|
309 | |
|
|
310 | my %switch_main = ( |
|
|
311 | 's' => sub { |
|
|
312 | |
|
|
313 | }, |
|
|
314 | 'w' => sub { |
|
|
315 | |
|
|
316 | }, |
|
|
317 | ); |
|
|
318 | |
|
|
319 | =pod |
| 282 | sub clean_windef { |
320 | sub clean_windef { |
| 283 | my ($self, $windef) = @_; |
321 | my ($self, $windef) = @_; |
| 284 | |
322 | |
| 285 | my $wd = {}; |
323 | my $wd = {}; |
| 286 | |
324 | |
| 287 | if ($windef =~ s/^(.*?)\365//) { |
325 | $wd->{title} = todelim \$windef; |
| 288 | $wd->{title} = $1; |
|
|
| 289 | } |
|
|
| 290 | |
326 | |
| 291 | while ($windef =~ s/^([^\343])//) { |
327 | while (not chk_flag \$windef) { |
|
|
328 | my $c = del1 \$windef; |
| 292 | if ($1 eq 's') { |
329 | if ($c eq 's') { |
| 293 | if ($windef =~ s/^(.*?)\365(.*?)\365//) { |
330 | $wd->{cmd} = todelim \$windef; |
| 294 | $wd->{cmd} = $1; |
331 | $wd->{nickname} = todelim \$windef; |
| 295 | $wd->{nickname} = $2; |
|
|
| 296 | } |
|
|
| 297 | } elsif ($1 eq 'w' or $1 eq 'p') { |
332 | } elsif ($c eq 'w' or $c eq 'p') { |
| 298 | $windef =~ s/^..//; |
333 | del2 \$windef; |
| 299 | } elsif ($1 eq 'h' or $1 eq 'f') { |
334 | } elsif ($c eq 'h' or $c eq 'f') { |
| 300 | $windef =~ s/^.//; |
335 | del1 \$windef; |
| 301 | } elsif ($1 eq 'r') { |
336 | } elsif ($c eq 'r') { |
| 302 | # ... resizeable |
337 | # ... resizeable |
| 303 | } |
338 | } |
| 304 | } |
339 | } |
| 305 | |
340 | |
|
|
341 | my $fl1 = 0; |
|
|
342 | do { # holgi, i will hit you |
|
|
343 | my $c = del1 \$windef; |
|
|
344 | |
|
|
345 | if ($c eq 'U') { |
|
|
346 | $wd->{weird_field} = todelim \$windef; |
|
|
347 | $fl1 = 1; |
|
|
348 | |
|
|
349 | } elsif ($c eq 'G') { |
|
|
350 | del2 \$windef; del2 \$windef; |
|
|
351 | |
|
|
352 | } elsif ($c eq 'F') { |
|
|
353 | |
|
|
354 | } elsif ($c eq 'B') { |
|
|
355 | del1 \$windef; |
|
|
356 | |
|
|
357 | } else { |
|
|
358 | $fl2 = 1; |
|
|
359 | $windef = $c . $windef; |
|
|
360 | } |
|
|
361 | } while ($fl1); |
|
|
362 | |
|
|
363 | while (not chk_flag \$windef) { |
|
|
364 | if ($fl2) { |
|
|
365 | my $c = del1 \$winddef |
|
|
366 | if (not ($c eq 'N' |
|
|
367 | or $c eq 'S' |
|
|
368 | or $c eq 'E' |
|
|
369 | or $c eq 'W' |
|
|
370 | or $c eq 'C')) |
|
|
371 | { |
|
|
372 | $windef = $c . $windef; |
|
|
373 | } |
|
|
374 | } |
|
|
375 | |
|
|
376 | } |
|
|
377 | |
| 306 | return $wd; |
378 | return $wd; |
| 307 | } |
379 | } |
|
|
380 | =cut |
| 308 | |
381 | |
| 309 | =item new Net::Knuddels::Client [IO::Socket::new arguments] |
382 | =item new Net::Knuddels::Client [IO::Socket::new arguments] |
| 310 | |
383 | |
| 311 | Create a new client connection. |
384 | Create a new client connection. |
| 312 | |
385 | |
| … | |
… | |
| 329 | |
402 | |
| 330 | $self->register ("(" => sub { |
403 | $self->register ("(" => sub { |
| 331 | $self->{login_challenge} = $_[0]; |
404 | $self->{login_challenge} = $_[0]; |
| 332 | $self->{login_room} = $_[1]; |
405 | $self->{login_room} = $_[1]; |
| 333 | $self->{proto}->feed_event ("login"); |
406 | $self->{proto}->feed_event ("login"); |
|
|
407 | }); |
|
|
408 | $self->register (k => sub { |
|
|
409 | my @str = map { s/[\356\343]//; $_ } @_; |
|
|
410 | my @out; |
|
|
411 | push @out, split /#/, $_ for @str; |
|
|
412 | $self->{proto}->feed_event (dialog => \@out); |
| 334 | }); |
413 | }); |
| 335 | $self->register (t => sub { |
414 | $self->register (t => sub { |
| 336 | my $src = $_[0]; |
415 | my $src = $_[0]; |
| 337 | if ($src eq '-') { |
416 | if ($src eq '-') { |
| 338 | $_[2] = $self->{knuddels_nick} . " " . $_[2]; |
417 | $_[2] = $self->{knuddels_nick} . " " . $_[2]; |
| … | |
… | |
| 494 | exists $self->{login_challenge} or Carp::croak "set_nick can only be called after a login event"; |
573 | exists $self->{login_challenge} or Carp::croak "set_nick can only be called after a login event"; |
| 495 | |
574 | |
| 496 | $self->{knuddels_nick} = $nick; |
575 | $self->{knuddels_nick} = $nick; |
| 497 | $self->command ("n", $room, $nick, Net::Knuddels::hash_pw $self->{login_challenge}, $password); |
576 | $self->command ("n", $room, $nick, Net::Knuddels::hash_pw $self->{login_challenge}, $password); |
| 498 | } |
577 | } |
|
|
578 | |
|
|
579 | =item $client->send_whois ($nick) |
|
|
580 | |
|
|
581 | Sends a whois-request for $nick. |
|
|
582 | |
|
|
583 | =cut |
|
|
584 | sub send_whois { |
|
|
585 | my ($self, $room, $nick) = @_; |
|
|
586 | |
|
|
587 | print "send: $room:/w $nick\n"; |
|
|
588 | $self->command ("e", $room, "/w $nick"); |
|
|
589 | } |
|
|
590 | |
| 499 | |
591 | |
| 500 | =item $client->send_room_msg ($nick, $room, $message) |
592 | =item $client->send_room_msg ($nick, $room, $message) |
| 501 | |
593 | |
| 502 | Sends a private C<$message> to C<$nick> over C<$room>. |
594 | Sends a private C<$message> to C<$nick> over C<$room>. |
| 503 | |
595 | |
