#!/net/etudiants/packages/perl-5.6.0/solaris/bin/perl # # les master et les bots peuvent deoper un bot # > un bot se doit d'auto-op les autres si c'est pas encore fait # > les masters sont masters sur tous les bots # ¿ # *** Dormeur (schurter@tanit.enserb.u-bordeaux.fr) has joined channel #enserb # *** Mode change "+o Dormeur" on channel #enserb by moustick # *** Signoff: Dormeur (Local Kill by Laulo (self kill)) # > ben ircII ne me le montre pas alors # :Laulo!schurter@mapplethorpe.enserb.u-bordeaux.fr KILL Dormeur :mapplethorpe.enserb.u-bordeaux.fr!Laulo (self kill) # ERROR :Closing Link: Dormeur[schurter@tanit.enserb.u-bordeaux.fr] Laulo (Local Kill by Laulo (self kill)) use strict; use Net::IRC; use POSIX qw(strftime); use Time::Local; use File::Copy; use FileHandle; use IPC::Open2; # # Create the IRC and Connection objects # my $irc = new Net::IRC; print "Creating connection to IRC server ($ARGV[0] || irc.enseirb.fr)...\n"; my $conn = $irc->newconn(Server => ($ARGV[0] || 'irc.enseirb.fr'), Port => 6667, Nick => 'Simplet', Ircname => 'Certifie 99% Perl et 1% Bash', Username => 'Boteuuux') or die "irctest: Can't connect to IRC server.\n"; my @zippy = ( "I am a traffic light, and Alan Ginsberg kidnapped my laundry in 1927!", "I'm a GENIUS! I want to dispute sentence structure with SUSAN SONTAG!!", "Now I'm telling MISS PIGGY about MONEY MARKET FUNDS!", "I have a VISION! It's a RANCID double-FISHWICH on an ENRICHED BUN!!", "My pants just went on a wild rampage through a Long Island Bowling Alley!!", "I always liked FLAG DAY!!", "I will establish the first SHOPPING MALL in NUTLEY, New Jersey...", "I used to be STUPID, too..before I started watching UHF-TV!!", "I smell like a wet reducing clinic on Columbus Day!", "Just walk along and try NOT to think about your INTESTINES being almost FORTY YARDS LONG!!", "It's the RINSE CYCLE!! They've ALL IGNORED the RINSE CYCLE!!", "Yow! It's some people inside the wall! This is better than mopping!", "Is the EIGHTIES when they had ART DECO and GERALD McBOING-BOING lunch boxes??", "This PIZZA symbolizes my COMPLETE EMOTIONAL RECOVERY!!", "I call it a \"SARDINE ON WHEAT\"!", "Is it FUN to be a MIDGET?", "Someone in DAYTON, Ohio is selling USED CARPETS to a SERBO-CROATIAN!!", ); my $simpletrc = "/net/e2/lochon/.simpletrc"; my $normal_op; my $weak_op; my $auto_op; my $pid_hal; my $channel1 = "\#enserb"; my $ip_erb = '((.*\.ensei?rb(\.|\.u-bordeaux\.)fr)|(147.210.(18|19|182|183).\d*))'; # en cas d'echec du fichier de config my $super_op = "(.*!lochon\@$ip_erb)|(lochon\@lochon\.mds)"; my $database = "/net/e2/lochon/.data_stations"; my $monsieur = "/net/e2/lochon/.irc_mr"; my $tamere = "/net/e2/lochon/.irc_ta_mere"; my $log_irc = "/net/e2/lochon/public_html/log_irc/enserb"; my $log_irc_old = "/net/e2/lochon/public_html/log_irc/enserb.old"; my $faq_enserb = "/net/e2/lochon/public_html/log_irc/faq_enserb.txt"; my $faq_enserb_new = "/net/e2/lochon/public_html/log_irc/faq_enserb.new"; my $signoff = "Yow!!"; my $day_last_who = 0; sub read_config { no strict 'refs'; my $nothing = 0; print STDOUT "Reading configuration file\n"; open (RCFILE, "<$simpletrc"); while ($_ = ) { SWITCH: { s/^super_op\s=\s// && do { s/(\$\w+)/eval($1)/ge; chop; $super_op = $_; print STDOUT "super_op :$super_op\n"; last SWITCH; }; s/^normal_op\s=\s// && do { s/(\$\w+)/eval($1)/ge; chop; $normal_op = $_; print STDOUT "normal_op:$normal_op\n";last SWITCH; }; s/^weak_op\s=\s// && do { s/(\$\w+)/eval($1)/ge; chop; $weak_op = $_; print STDOUT "weak_op :$weak_op\n"; last SWITCH; }; s/^auto_op\s=\s// && do { s/(\$\w+)/eval($1)/ge; chop; $auto_op = $_; print STDOUT "auto_op :$auto_op\n"; last SWITCH; }; s/^channel\s=\s// && do { s/(\$\w+)/eval($1)/ge; chop; $channel1 = "\#$_"; print STDOUT "channel :$channel1\n"; last SWITCH; }; $nothing = 1; }; }; print STDOUT "Done.\n\n"; print STDOUT "Initializing megahal...\n"; $pid_hal = open2(*READ_HAL, *WRITE_HAL, "cd /net/e2/lochon/megahal && /net/e2/lochon/megahal/megahal_sunos 2>/dev/null"); WRITE_HAL->autoflush(); print STDOUT "Megahal ok (pid $pid_hal)\n\n"; } sub on_connect { my $self = shift; my $temp; open (LOG_IRC, ">>$log_irc"); select(LOG_IRC); $| = 1; $temp = strftime "%a %b %e %H:%M:%S %Y", localtime; print LOG_IRC "IRC log started ", $temp, "\n"; print LOG_IRC "Joining $channel1...\n"; $self->join($channel1); $self->schedule(2, \&Net::IRC::Connection::mode, $channel1, "+nt"); $temp = ; $self->schedule(3, \&Net::IRC::Connection::privmsg, $channel1, $temp); close (LOG_IRC); } # Handles some messages you get when you connect sub on_init { my ($self, $event) = @_; my (@args) = ($event->args); shift (@args); print STDOUT "*** @args\n"; } sub on_part { open (LOG_IRC, ">>$log_irc"); my ($self, $event) = @_; my ($channel) = ($event->to)[0]; my $heure = &heure_min; printf LOG_IRC "%s *** %s (%s) has left channel %s\n", $heure, $event->nick, $event->userhost, $channel; close (LOG_IRC); } sub on_join { open (LOG_IRC, ">>$log_irc"); my ($self, $event) = @_; my ($channel) = ($event->to)[0]; my ($msg_host) = ($event->from); my $heure = &heure_min; printf LOG_IRC "%s *** %s (%s) has joined channel %s\n", $heure, $event->nick, $event->userhost, $channel; if ($msg_host =~ /$auto_op/) { $self->mode($channel, "+o", $event->nick); }; close (LOG_IRC); } sub on_mode { open (LOG_IRC, ">>$log_irc"); my ($self, $event) = @_; my $heure = &heure_min; my (@tablo_temp, $ini_pos); print STDOUT $event->type()," ",$event->args," ",$event->to," ",$event->from,"\n"; if (($event->to())[0] =~ /\#/) { print LOG_IRC "$heure *** Mode change ",join (' ',$event->args)," on channel ",($event->to())[0]," by ",$event->nick,"\n"; }; close (LOG_IRC); # if ( ($event->args[0]) =~ /o/) { #*** RAW_IRC activated by "*.DE MODE #perl +o xteddy" #*** RAW_IRC activated by "Simplet!lochon@excuse.enserb.fr MODE #enserb +o ptigael" # $ini_pos = 0; while ($ini_pos != -1) {index $event->args[0], "o", $ini_pos+1; push @tablo_temp;} # }; } sub on_quit { open (LOG_IRC, ">>$log_irc"); my ($self, $event) = @_; my $heure = &heure_min; printf LOG_IRC "%s *** Signoff : %s (%s)\n", $heure, $event->nick, $event->args; close (LOG_IRC); } sub on_kill { open (LOG_IRC, ">>$log_irc"); my ($self, $event) = @_; my $heure = &heure_min; printf LOG_IRC "%s *** Signoff : %s (Local Kill by %s (%s))\n", $heure, $self->nick, $event->nick, $event->args; close (LOG_IRC); } sub on_kick { open (LOG_IRC, ">>$log_irc"); my ($self, $event) = @_; my $heure = &heure_min; printf LOG_IRC "%s *** %s has been kicked from channel %s by %s (%s) %s\n", $heure, ($event->to)[0], ($event->args)[0], $event->nick, ($event->args)[1]; if (($event->to)[0] eq $self->nick) { $self->schedule(2, \&Net::IRC::Connection::join, $channel1); }; close (LOG_IRC); } sub on_nick { open (LOG_IRC, ">>$log_irc"); my ($self, $event) = @_; my $heure = &heure_min; printf STDOUT "%s *** %s is now known as %s\n", $heure, $event->nick, ($event->args)[0]; printf LOG_IRC "%s *** %s is now known as %s\n", $heure, $event->nick, ($event->args)[0]; close (LOG_IRC); } # What to do when we receive a private PRIVMSG. sub on_msg { my ($self, $event) = @_; my ($nick) = $event->nick; my $heure = &heure_min; my ($nb_a, $nb_m, $nb_o, $nb_u, $nb_r); # print STDOUT "$heure *$nick* ", ($event->args), "\n"; # $self->privmsg($nick, &pickrandom()); # Say a Zippy quote. } # Display formatted CTCP ACTIONs. sub on_action { open (LOG_IRC, ">>$log_irc"); my ($self, $event) = @_; my ($nick, @args) = ($event->nick, $event->args); my $heure = &heure_min; # :FIXME: this should not be necessary: shift @args; print LOG_IRC "$heure * $nick @args\n"; close (LOG_IRC); } # What to do when we receive channel text. sub on_public { open (LOG_IRC, ">>$log_irc"); my ($self, $event) = @_; my @to = $event->to; my ($channel) = ($event->to)[0]; my ($nick, $mynick) = ($event->nick, $self->nick); my ($arg) = ($event->args); my ($msg_host) = ($event->from); my ($temp,$temp2,$tamp,$tamp2,$trouve,$whoset,@tablo_t); my ($nb_a, $nb_m, $nb_o, $nb_u, $nb_r, $nb_v, $nb_l); my $heure = &heure_min; my ($quote1,$quote2); # Note that $event->to() returns a list (or arrayref, in scalar # context) of the message's recipients, since there can easily be # more than one. printf STDOUT "%s <%9s> %s\n", $heure, $nick, $arg; printf LOG_IRC "%s <%9s> %s\n", $heure, $nick, $arg; if ($msg_host =~ /$super_op/) { if ($arg =~ /^\[rehash\]/i) { read_config; } elsif ($arg =~ /^Go away/i) { # Tell him to leave, and he does. $self->quit($signoff); printf LOG_IRC "%s *** Signoff : %s (%s)\n", $heure, $self->nick, $signoff; $temp = strftime "%a %b %e %H:%M:%S %Y", localtime; print LOG_IRC "IRC log ended ", $temp, "\n"; close (LOG_IRC); print WRITE_HAL "\#QUIT\n\n"; exit 127; } elsif ($arg =~ /^Restart/i) { $self->quit($signoff); printf LOG_IRC "%s *** Signoff : %s (%s)\n", $heure, $self->nick, $signoff; $temp = strftime "%a %b %e %H:%M:%S %Y", localtime; print LOG_IRC "IRC log ended ", $temp, "\n"; close (LOG_IRC); print WRITE_HAL "\#QUIT\n\n"; exit 0; } elsif ($arg =~ s/^\[nick\] //i) { $self->nick($arg); } elsif ($arg =~ s/^\[server\] //i) { print STDOUT "server: $arg,6667\n"; $self->connect(Server => $arg, Port => 6667); } elsif ($arg =~ s/^\[do\] //i) { $self->sl($arg); } elsif ($arg =~ s/^\[ultra\] //i) { $self->kick($channel, $arg, 'on rigole pas qd mon maitre a pas son ultra ;D' ); }; }; if ( ($msg_host =~ /$auto_op/) || ($msg_host =~ /$normal_op/) || ($msg_host =~ /$super_op/) ) { if ($arg =~ /^\[opme\]/i) { $self->mode ($channel, "+o", $nick); } elsif ($arg =~ s/^\[mode\] //i) { $self->mode($channel, $arg); } elsif ($arg =~ s/^\[op\] //i) { $self->mode($channel, "+o", $arg); } elsif ($arg =~ s/^\[ik\] //i) { $_ = $arg; /^(\S*) (.*)/; ($temp, $tamp) = ($1 ,$2); $temp2 = "$nick - $tamp"; $self->mode($channel, "+i"); $self->kick($channel, $temp, $temp2 ); $self->schedule(2, \&Net::IRC::Connection::mode, $channel, "-i"); } elsif ($arg =~ s/^\[k\] //i) { $_ = $arg; if (/^(\S*) (.*)/) {($temp, $tamp) = ($1 ,$2)} else {($temp, $tamp) = ($_, "out !")}; $temp2 = "$nick - $tamp"; $self->kick($channel, $temp, $temp2 ); } elsif ($arg =~ /^\[getlog\]/i) { $self->schedule(1, \&Net::IRC::Connection::new_send, $nick, $log_irc); # $self->new_send( $nick, $log_irc); } elsif ($arg =~ /^\[getoldlog\]/i) { $self->new_send( $nick, $log_irc_old); } elsif ($arg =~ s/^\[sendlog\] //i) { } elsif ($arg =~ s/^\[sendoldlog\] //i) { }; }; if ( ($msg_host =~ /$weak_op/) || ($msg_host =~ /$normal_op/) || ($msg_host =~ /$super_op/) ) { if ($arg =~ s/^\[topic\] //i) { if (length ($arg) <81) { $self->topic($channel,$arg) } else { $self->privmsg( $channel, "Topic trop long de ",(length($arg)-80),"caracteres"); printf STDOUT "$heure <%9s> Topic trop long de %d caracteres\n", $heure, $self->nick,(length($arg)-80); } } elsif ($arg =~ s/^\[hot\] //i) { if (length ($arg) <55) { $self->topic($channel, "Chaude ligne de l'ENSERB: $arg") } else { $self->privmsg( $channel, "Topic trop long de ",(length($arg)-54),"caracteres"); printf STDOUT "$heure <%9s> Topic trop long de %d caracteres\n", $heure, $self->nick,(length($arg)-54); } } elsif ($arg =~ s/^$mynick.\s*//i) { print STDOUT "hal..."; print STDOUT " $arg"; if ( ($arg =~ /^\#/) && ($msg_host =~ /$super_op/) ) { print WRITE_HAL "$arg\n\n"; print STDOUT "\n"; } elsif ($arg !~ /^\#/) { print WRITE_HAL "$arg\n\n"; $temp = ; $self->privmsg( $channel, $temp); printf "%s <%9s> %s", $heure, $mynick, $temp; print STDOUT " -> $temp"; }; } elsif ($arg =~ s/^\?del //) { open (FAQ, "<$faq_enserb"); open (New_FAQ, ">$faq_enserb_new"); while ($_ = ) { chop ($_); ($tamp2, $temp2,$whoset) = split (/\*/, $_); $tamp = $arg; $quote1 = $arg; $tamp2 =~ s/\\(.)/$1/g; # if (uc($tamp) eq uc($quote2)) { if (uc($tamp2) ne uc($quote1)) { printf New_FAQ "%s\n", $_; } else { print STDOUT "Deleted: $arg\n"; $self->privmsg( $channel, "Deleted: $arg"); printf "%s <%9s> Deleted: %s\n", $heure, $self->nick, $arg; }; }; close (FAQ); close (New_FAQ); move($faq_enserb,"/dev/null"); move($faq_enserb_new, $faq_enserb); } elsif ($arg =~ /^\?! .*==.*/) { $arg =~ s/^\?! //; open (FAQ, "<$faq_enserb"); $trouve = ''; $tamp = ''; while ($_ = ) { chop ($_); ($tamp,$temp) = split (/==/, $arg); ($tamp2, $temp2,$whoset) = split (/\*/, $_); $tamp =~ s/\s*$//; $temp =~ s/^\s*//; $temp =~ s/\*/x/g; $quote1 = $tamp; $tamp2 =~ s/\\(.)/$1/g; # if (uc($tamp) eq uc($quote2)) { if (uc($tamp2) eq uc($quote1)) { $trouve = $tamp2; $self->privmsg( $channel, "$tamp est deja defini"); printf STDOUT "%s <%9s> %s est deja defini\n", $heure, $self->nick, $tamp; printf "%s <%9s> %s est deja defini\n", $heure, $self->nick, $tamp; }; }; close (FAQ); $quote2 = $trouve; if ($tamp !~ /$quote2/i) { $self->privmsg( $channel, "Now: $tamp = $temp"); printf STDOUT "%s <%9s> Now: %s = %s\n", $heure, $self->nick, $tamp, $temp; printf "%s <%9s> Now: %s = %s\n", $heure, $self->nick, $tamp, $temp; $tamp = quotemeta $tamp; open (FAQ, ">>$faq_enserb"); printf FAQ "%s*%s*%s\n", $tamp, $temp, $event->from; close (FAQ); }; }; }; if ($arg =~ /^\[faiscaca\]/) { $self->me($channel ,"se defroque et en met partout"); printf STDOUT "%s * %s se defroque et en met partout\n", $heure, $self->nick; } elsif ($arg =~ /^\[rigole\]/) { $self->privmsg( $channel, "hihi :D"); printf STDOUT "%s <%9s> hihi :D\n", $heure, $self->nick; printf "%s <%9s> hihi :D\n", $heure, $self->nick; } elsif ($arg =~ /^\[pleure\]/) { $self->privmsg( $channel, "ouinnnn :("); printf STDOUT "%s <%9s> ouinnnn :(\n", $heure, $self->nick; printf "%s <%9s> ouinnnn :(\n", $heure, $self->nick; } elsif ($arg =~ s/^\[ous\] //i) { $self->privmsg( $channel, &ou_machine($arg)); printf STDOUT "%s <%9s> %s\n", $heure, $self->nick,&ou_machine($arg); printf "%s <%9s> %s\n", $heure, $self->nick,&ou_machine($arg); } elsif ($arg =~ s/^\[quiestla\] //i) { $temp = &quiestla($arg); $self->privmsg( $channel, $temp," (",&ou_machine($temp),")"); printf STDOUT "%s <%9s> %s (%s)\n", $heure, $self->nick, $temp, &ou_machine($temp); printf "%s <%9s> %s (%s)\n", $heure, $self->nick, $temp, &ou_machine($temp); } elsif ($arg =~ /^\[mr\]/i) { ($temp,$temp2) = @{&monsieur}; $self->privmsg( $channel, "Monsieur et Madame $temp2 ont un enfant. Comment l'appellent-ils ?"); printf STDOUT "%s <%9s> Monsieur et Madame %s ont un enfant. Comment l'appellent-ils ?\n", $heure, $self->nick, $temp2; $self->privmsg( $channel, "$temp. Car $temp $temp2"); printf "%s <%9s> %s. Car %s %s\n", $heure, $self->nick, $temp, $temp, $temp2; } elsif ($arg =~ s/^\[tm\] //i) { $tamp = $arg; $temp = &tamere; $self->privmsg( $channel, "$tamp: $temp"); printf STDOUT "%s <%9s> %s: %s\n", $heure, $self->nick, $tamp, $temp; printf "%s <%9s> %s: %s\n", $heure, $self->nick, $tamp, $temp; } elsif ($arg =~ s/^\[love\] //i) { $nb_a = ($arg =~ /a/i); $nb_m = ($arg =~ /m/i); $nb_o = ($arg =~ /o/i); $nb_u = ($arg =~ /u/i); $nb_r = ($arg =~ /r/i); $nb_l = ($arg =~ /l/i);# $nb_v = ($arg =~ /e/i); # ($nb_a, $nb_m, $nb_o, $nb_u, $nb_l, $nb_v) = (($nb_a+$nb_m) % 10, ($nb_m+$nb_o) % 10, ($nb_o+$nb_u) % 10, ($nb_u+$nb_r) % 10, ($nb_r+$nb_l) % 10, ($nb_l+$nb_v) % 10); ($nb_a, $nb_m, $nb_o, $nb_u, $nb_l) = (($nb_a+$nb_m) % 10, ($nb_m+$nb_o) % 10, ($nb_o+$nb_u) % 10, ($nb_u+$nb_r) % 10, ($nb_r+$nb_l) % 10); ($nb_a, $nb_m, $nb_o, $nb_u) = (($nb_a+$nb_m) % 10, ($nb_m+$nb_o) % 10, ($nb_o+$nb_u) % 10, ($nb_u+$nb_r) % 10); ($nb_a, $nb_m, $nb_o) = (($nb_a+$nb_m) % 10, ($nb_m+$nb_o) % 10, ($nb_o+$nb_u) % 10); ($nb_a, $nb_m) = (($nb_a+$nb_m) % 10, ($nb_m+$nb_o) % 10); $nb_a = $nb_a * 10 + $nb_m + 1; $self->privmsg( $channel, "Pourcentage de compatibilité: $nb_a %"); printf STDOUT "%s <%9s> Pourcentage de compatibilité: %s %\n", $heure, $self->nick, $nb_a; printf "%s <%9s> Pourcentage de compatibilité: %s %\n", $heure, $self->nick, $nb_a; } elsif ($arg =~ s/^\[marmotte\]//i) { $self->privmsg( $channel, "Et la marmotte, elle met le chocolat dans le papier d'alu !$arg"); printf STDOUT "%s <%9s> Et la marmotte, elle met le chocolat dans le papier d'alu !%s\n", $heure, $self->nick, $arg; printf "%s <%9s> Et la marmotte, elle met le chocolat dans le papier d'alu !%s\n", $heure, $self->nick, $arg; } elsif ($arg =~ s/^\[ou\] //i) { $self->userhost($arg); } elsif ($arg =~ /^\[ping\]/i) { $self->privmsg( $channel, "pong"); printf STDOUT "%s <%9s> pong\n", $heure, $self->nick; printf "%s <%9s> pong\n", $heure, $self->nick; } elsif ($arg =~ /\[time\]/) { $self->privmsg( $channel, $heure); printf STDOUT "%s <%9s> %s: %s\n", $heure, $self->nick, $heure; printf "%s <%9s> %s: %s\n", $heure, $self->nick, $heure; } elsif ($arg =~ /^\[libre\]/) { open (QUI, "quiestla -n elec|"); $temp =""; while ($_= ) { if (/(auric|milhaud|taillefer|honegger|dury|poulenc) start/) { $temp = "$temp $1";}; }; if ($temp eq "") { $self->privmsg( $channel, "Les ultra5 sont libres"); } else { $temp =~ s/^ //; $self->privmsg( $channel, "$temp sont occupees"); }; } elsif ($arg =~ s/^\?\? //) { open (FAQ, "<$faq_enserb"); $trouve =''; while ($_ =) { chop ($_); ($tamp,$temp,$whoset) = split (/\*/, $_); $quote2 = $arg; $tamp =~ s/\\(.)/$1/g; if (uc($tamp) eq uc($quote2)) { $trouve = $tamp; $self->privmsg( $channel, "$arg : $temp"); printf STDOUT "%s <%9s> %s : %s\n", $heure, $self->nick, $arg, $temp; printf "%s <%9s> %s : %s\n", $heure, $self->nick, $arg, $temp; }; }; $quote2 = $trouve; if ($arg !~ /$quote2/i) { $self->privmsg( $channel, "Aucune information sur $arg"); printf STDOUT "%s <%9s> Aucune information sur %s\n", $heure, $self->nick, $arg; printf "%s <%9s> Aucune information sur %s\n", $heure, $self->nick, $arg; }; close (FAQ); } elsif ($arg =~ s/^\?whoset //) { open (FAQ, "<$faq_enserb"); $trouve =''; while ($_ =) { chop ($_); ($tamp,$temp,$whoset) = split (/\*/, $_); $quote2 = $arg; $tamp =~ s/\\(.)/$1/g; if (uc($tamp) eq uc($quote2)) { $trouve = $tamp; $self->privmsg( $channel, "$arg set by $whoset"); printf STDOUT "%s <%9s> %s set by %s\n", $heure, $self->nick, $arg, $whoset; printf "%s <%9s> %s set by %s\n", $heure, $self->nick, $arg, $whoset; }; }; $quote2 = $trouve; if ($arg !~ /$quote2/i) { $self->privmsg( $channel, "Aucune information sur $arg"); printf STDOUT "%s <%9s> Aucune information sur %s\n", $heure, $self->nick, $arg; printf "%s <%9s> Aucune information sur %s\n", $heure, $self->nick, $arg; }; close (FAQ); }; close (LOG_IRC); } # if ($arg =~ /^Chat/i) { # Request a DCC Chat initiation # $self->new_chat(1, $event->nick, $event->host); # } # You can invoke this next part with "Send me Filename" or # "Send Filename to me". It doesn't much like ending punctuation, though. # $arg =~ s/[^"'\w]*?\b(to|me)\b[^'"\w]*?//g; # # if ($arg =~ /^send\s+(\S+)\s*/i) { # if (-e $1) { # $self->privmsg($nick, "Sending $1 in 10 seconds..."); # $self->schedule(10, \&Net::IRC::Connection::new_send, $nick, $1); # } else { # $self->privmsg($nick, "No such file as $1, sorry."); # } # } sub on_userhostreply { open (LOG_IRC, ">>$log_irc"); my ($self, $event) = @_; # my ($channel) = ($event->to)[0]; #marche pas sur le userhost :( my $heure = &heure_min; my (@args) = ($event->args); my $login; shift (@args); $_ = $args[0]; /=[+-](.*)@.*$/; $login = $1; if (defined ($login)) { $self->privmsg( $channel1, &ou_machine(&quiestla($login))); printf STDOUT "%s <%9s> %s,(%s)\n", $heure, $self->nick, &ou_machine(&quiestla($login)), $login; printf LOG_IRC "%s <%9s> %s\n", $heure, $self->nick, &ou_machine(&quiestla($login)); } else { $self->privmsg( $channel1, "Nick inconnu"); printf STDOUT "%s <%9s> %s,(%s)\n", $heure, $self->nick, "Nick inconnu", $login; printf LOG_IRC "%s <%9s> %s\n", $heure, $self->nick, "Nick inconnu"; }; close (LOG_IRC); } # What to do when we receive a message via DCC CHAT. sub on_chat { my ($self, $event) = @_; my ($sock) = ($event->to)[0]; print STDOUT '*' . $event->nick . '* ' . join(' ', $event->args), "\n"; $self->privmsg($sock, &pickrandom()); # Say a Zippy quote. } sub on_names { my ($self, $event) = @_; my (@list, $channel) = ($event->args); # eat yer heart out, mjd! # splice() only works on real arrays. Sigh. ($channel, @list) = splice @list, 2; # print "Users on $channel: @list\n"; $self->who($channel); } sub on_whoreply { open (LOG_IRC, ">>$log_irc"); my ($self, $event) = @_; my $temp = ($event->args)[7]; if ($day_last_who != &today) { $self->schedule_abs(timelocal(0 ,1 ,0 ,&jour_demain ,&mois_demain ,&annee_demain), \&Net::IRC::Connection::who, $channel1); #on programme le lendemain a minuit 1 }; $day_last_who = &today; # $temp = s/^..//; printf LOG_IRC "%-10s %-9s %-3s %s@%s (%s)\n", ($event->args)[1], ($event->args)[5], ($event->args)[6], ($event->args)[2], ($event->args)[3], $temp; close (LOG_IRC); } # What to do when we receive a DCC SEND or CHAT request. sub on_dcc { my ($self, $event) = @_; my $type = ($event->args)[1]; if (uc($type) eq 'SEND') { # open TEST, ">/tmp/net-irc.dcctest" # or do { warn "Can't open test file: $!"; return; }; # $self->new_get($event, \*TEST); # print STDOUT "Saving incoming DCC SEND to /tmp/net-irc.dcctest\n"; } elsif(uc($type) eq 'CHAT') { $self->new_chat($event); } else { print STDERR ("Unknown DCC type: " . $type); } } # Yells about incoming CTCP PINGs. sub on_ping { my ($self, $event) = @_; my $nick = $event->nick; $self->ctcp_reply($nick, join (' ', ($event->args))); print STDOUT "*** CTCP PING request from $nick received\n"; } # Gives lag results for outgoing PINGs. sub on_ping_reply { my ($self, $event) = @_; my ($args) = ($event->args)[1]; my ($nick) = $event->nick; $args = time - $args; print STDOUT "*** CTCP PING reply from $nick: $args sec.\n"; } # Change our nick if someone stole it. sub on_nick_taken { my ($self) = shift; $self->nick(substr($self->nick, -1) . substr($self->nick, 0, 8)); } sub on_version { my ($self, $event) = @_; my ($nick) = $event->nick; print STDOUT "Version request from $nick"; $self->ctcp_reply($nick, "Net-IRC 0.63:Alpha 0:Perl 5.6.0"); } # Reconnect to the server when we die. sub on_disconnect { open (LOG_IRC, ">>$log_irc"); my ($self, $event) = @_; print LOG_IRC "Disconnected from ", $event->from(), " (", ($event->args())[0], "). Attempting to reconnect...\n"; $self->schedule(10, \&Net::IRC::Connection::connect(Server => 'salambo', Port => 6667) ); close (LOG_IRC); } # Look at the topic for a channel you join. sub on_topic { open (LOG_IRC, ">>$log_irc"); my ($self, $event) = @_; my @args = $event->args(); my $heure = &heure_min; # print $event->type()," ",$event->args," ",$event->to," ",$event->from,"\n"; if ($args[1]) { #332 print LOG_IRC "The topic for $args[1] is $args[2]\n"; } elsif ($event->type() eq 'topic') { #topic change printf LOG_IRC "%s *** %s has changed topic on %s to : %s\n", $heure, $event->nick, $event->to, @args; }; close (LOG_IRC); } sub on_not_joined { my ($self, $event) = @_; $self->schedule(65, \&Net::IRC::Connection::join, $channel1); } sub today { my @tablo = localtime; return $tablo[3]; } sub jour_demain { my @tablo = localtime(time + 86400); return $tablo[3]; } sub mois_demain { my @tablo = localtime(time + 86400); return $tablo[4]; } sub annee_demain { my @tablo = localtime(time + 86400); return $tablo[5]; } sub heure_min { my @tablo = localtime; $_ = "$tablo[2]:$tablo[1]"; s/^(\d):/0$1:/; s/:(\d)$/:0$1/; return $_; } sub pickrandom { # Choose a random quote from the @zippy array. return $zippy[ rand scalar @zippy ]; } sub quiestla { my ($nom) = @_; my $machine = "aucune"; open (KIKESLA, "/opt/jumble/bin/quiestla|"); while ( $_ = ) { if (/$nom on(.*)start.*/) { $machine = $1; $machine =~ s/ //g; /:/ && $machine =~ s/^.*:(.*)$/$1/; }; }; return $machine; } sub monsieur { my ($prenom,$nom) = ("",""); my ($line,$seekline) = (0,rand(963)); open (DATA, "< $monsieur"); while(defined ($_=) and $line++<$seekline){} $_ = ; chop ($_); if ( s/^assign monsieur\.\d* //i ) { ($prenom,$nom) = split (/:/,$_); }; return ([($prenom,$nom)]); } sub tamere { my $insulte = ""; my ($line,$seekline) = (0,rand(279)); open (DATA, "< $tamere"); while(defined ($_=) and $line++<$seekline){} $_ = ; chop ($_); if ( s/^assign blague\.\d* //i ) { $insulte = $_; }; # print $insulte; return $insulte; close (DATA); } sub ou_machine { my ($machine) = @_; my ($nom,$ouca) = ("grrr",""); my ($salle,$ou_salle,$ki_prof,$str_koi) = ("","","",""); open (DATA, "< $database"); while ( defined ($_ = ) && ($nom ne $machine) ) { chop ($_); if ( $_ ne "") { s/^assign station\.\d* //i; ($nom,$ouca) = split (/:/,$_); }; }; $str_koi = "Je sais pas"; if ($nom eq $machine) { $salle = substr ($ouca,0,2); $ou_salle = substr ($ouca,2,2); $ki_prof = substr ($ouca,4,200); if ($salle eq "g1") { $str_koi = "Premiere grande salle elec"}; if ($salle eq "g2") { $str_koi = "Deuxieme grande salle elec"}; if ($salle eq "p1") { $str_koi = "Premiere petite salle elec"}; if ($salle eq "p2") { $str_koi = "Deuxieme petite salle elec"}; if ($salle eq "ue") { $str_koi = "Salle des ultra elec"}; if ($salle eq "se") { $str_koi = "Server elec"}; if ($salle eq "si") { $str_koi = "Server info"}; if ($salle eq "sn") { $str_koi = "Server news"}; if ($salle eq "f-") { $str_koi = "Machine de"}; if ($salle eq "i1") { $str_koi = "Rez de chaussee info, premiere salle"}; if ($salle eq "i2") { $str_koi = "Rez de chaussee info, deuxieme salle"}; if ($salle eq "i3") { $str_koi = "Rez de chaussee info, troisieme salle"}; if ($salle eq "te") { $str_koi = "Salle des TX elec"}; if ($salle eq "t2") { $str_koi = "Salle des TX noir et blanc info"}; if ($salle eq "t1") { $str_koi = "Premiere salle de TX info"}; if ($salle eq "t3") { $str_koi = "Troisieme salle de TX info"}; if ($salle eq "t4") { $str_koi = "Quatrieme salle de TX info"}; if ($salle eq "t5") { $str_koi = "Deuxieme salle de TX info"}; if ($salle eq "ui") { $str_koi = "Salle des Ultra info"}; if ($salle eq "pr") { $str_koi = "Salle de projet"}; if ($salle eq "ro") { $str_koi = "Club robot"}; if ($salle eq "f-") { $str_koi = "$str_koi $ki_prof"}; if ($ou_salle eq "e1") { $str_koi = "$str_koi elec, premier etage"}; if ($ou_salle eq "e0") { $str_koi = "$str_koi elec, rez de chaussee"}; if ($ou_salle eq "r1") { $str_koi = "$str_koi, premiere rangee en partant du tableau"}; if ($ou_salle eq "r2") { $str_koi = "$str_koi, deuxieme rangee en partant du tableau"}; if ($ou_salle eq "r3") { $str_koi = "$str_koi, troiseme rangee en partant du tableau"}; if ($ou_salle eq "r4") { $str_koi = "$str_koi, quatrieme rangee en partant du tableau"}; if ($ou_salle eq "r5") { $str_koi = "$str_koi, cinquieme rangee en partant du tableau"}; if ($ou_salle eq "r6") { $str_koi = "$str_koi, sixieme rangee en partant du tableau"}; if ($ou_salle eq "gm") { $str_koi = "$str_koi, au fond a gauche en entrant, contre le mur"}; if ($ou_salle eq "ge") { $str_koi = "$str_koi, immediatement a gauche, en entrant"}; if ($ou_salle eq "gf") { $str_koi = "$str_koi, au fond a gauche en entrant"}; if ($ou_salle eq "gw") { $str_koi = "$str_koi, au fond a gauche en entrant, pres de la fenetre"}; if ($ou_salle eq "de") { $str_koi = "$str_koi, immediatement a droite, en entrant"}; if ($ou_salle eq "df") { $str_koi = "$str_koi, au fond a droite en entrant"}; if ($ou_salle eq "dw") { $str_koi = "$str_koi, au fond a droite en entrant, pres de la fenetre"}; if ($ou_salle eq "fe") { $str_koi = "$str_koi, immediatement en face en entrant"}; if ($ou_salle eq "we") { $str_koi = "$str_koi, au fond en entrant, pres de la fenetre"}; if ($ou_salle eq "ew") { $str_koi = "$str_koi, en face de l'entree, pres de la fenetre"}; if ($ou_salle eq "f") { $str_koi = "$str_koi, face a la fenetre"}; if ($ou_salle eq "m") { $str_koi = "$str_koi, face au mur"}; if ($ou_salle eq "u") { $str_koi = "$str_koi, salle des machines rez de chausee info"}; if ($ou_salle eq "v") { $str_koi = "$str_koi, quelque part"}; }; return $str_koi; close (DATA); } read_config; print STDOUT "Installing handler routines..."; $conn->add_handler('cping', \&on_ping); $conn->add_handler('crping', \&on_ping_reply); $conn->add_handler('cversion', \&on_version); $conn->add_handler('msg', \&on_msg); $conn->add_handler('chat', \&on_chat); $conn->add_handler('public', \&on_public); $conn->add_handler('caction', \&on_action); $conn->add_handler('join', \&on_join); $conn->add_handler('part', \&on_part); $conn->add_handler('quit', \&on_quit); $conn->add_handler('kill', \&on_kill); $conn->add_handler('kick', \&on_kick); $conn->add_handler('mode', \&on_mode); $conn->add_handler('topic', \&on_topic); $conn->add_handler('notopic', \&on_topic); $conn->add_handler('nick', \&on_nick); $conn->add_handler('cdcc', \&on_dcc); $conn->add_global_handler([ 251,252,253,254,255 ], \&on_init); $conn->add_global_handler('disconnect', \&on_disconnect); $conn->add_global_handler(376, \&on_connect); $conn->add_global_handler(433, \&on_nick_taken); $conn->add_global_handler(353, \&on_names); $conn->add_global_handler(352, \&on_whoreply); $conn->add_global_handler(302, \&on_userhostreply); $conn->add_global_handler([ 471,474,475,476 ], \&on_not_joined); print STDOUT " done.\n"; print STDOUT "starting...\n"; $irc->start;