Bot en perl

Ce bot en perl est inspiré d'un exemple des éditions O'Reilly. Il suffit de le lancer avec 
./bot.pl nick-bot irc.server.net \#chan admin1 admin2 admin3
N'oubliez pas d'échapper le dièse du canal !
Après, lisez le code source pour comprende !

Quelques commandes

Comme j'ai un peu de temps, je vous donne quelques exemples :
  • !memo nick message va enregistrer le "message" (un ou plusieurs mots) pour le nick. Il délivera le message la prochaine fois que le nick apparaitra sur le canal et supprimera le message
  • !time donne la date
  • !mute le rend muet sur le canal (mais pas dans les autres s'il est lance dans plusieurs canaux)
  • etc.
  1. #!/usr/bin/perl -w
  2. # irc.pl
  3. # A simple IRC robot.
  4. # Usage: $ perl bot.pl nick server \#chann admin
  5. # N'oubliez pas le caractere d'echapement \ avant le # du chan !
  6.  
  7. use strict;
  8. use Switch;
  9.  
  10. # We will use a raw socket to connect to the IRC server.
  11. use IO::Socket;
  12.  
  13. # The server to connect to and our details.
  14. my %admin;
  15. my %query;
  16. my %quit;
  17. my %messages;
  18. my $from;
  19. my $server = "irc.freenode.net";
  20. my $nick = "chtibot";
  21. my $login = "simple_bot";
  22. my $users;
  23. my $nombre = 0;
  24. # The channel which the bot will join.
  25. my $channel = "#botest";
  26.  $nick = $ARGV[0];
  27.  $server = $ARGV[1];
  28.  $channel = $ARGV[2];
  29.   $admin{$ARGV[3]} = 1;
  30.   $admin{$ARGV[4]} = 1;
  31.   $admin{$ARGV[5]} = 1;
  32. my $to;
  33. my @arg;
  34. my $action;
  35. my %mute;
  36. print "-$nick-!-$server-!-$channel\n";
  37. # Connect to the IRC server.
  38. my $sock = new IO::Socket::INET(PeerAddr => $server,
  39.                                 PeerPort => 6667,
  40.                                 Proto => 'tcp') or
  41.                                     die "Can't connect\n";
  42.  
  43. sub msgti() {
  44. if(!$mute{$to}) {
  45. my ($chan,$text) = @_;
  46. print $sock "PRIVMSG $chan :$text\r\n";
  47. }
  48. }
  49.  
  50. sub getdate() {
  51.                 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
  52. return  $mday."/".($mon+1)."/".(1900+$year).", vers ".$hour."h ".$min."m ".$sec."s";
  53. }
  54.  
  55. sub ctime() {
  56. &msgti($to,"Nous sommes le ".getdate()); }
  57.  
  58. sub list() {
  59. &msgti($to,"!stat, !mute, !time, !last, !memo, !list, !query"); }
  60.  
  61. sub stats() {
  62. print $sock "who $to\r\n";
  63. $nombre = 0; }
  64.  
  65. sub query() {
  66. my ($pseudo,$query) = @_;
  67. if($query) {
  68.         $query{lc($pseudo)} = $query;
  69. } elsif($query{lc($pseudo)}) {
  70.         &msgti($to,"$pseudo a dit \"".$query{lc($pseudo)}."\"");
  71. } else { &msgti($to,"$pseudo n'a rien dit");
  72. }
  73. }
  74.  
  75. sub clast() {
  76. my ($pseudo) = @_;
  77. if($quit{lc($pseudo)}) {
  78. &msgti($to,"La derniere fois que j'ai vu partir $pseudo, c'etait le ".$quit{lc($pseudo)}{date}." : \"".$quit{lc($pseudo)}{raison}."\""); }
  79. }
  80.  
  81. sub memo() {
  82. my ($pseudo,$memo) = @_;
  83. $messages{lc($pseudo)}{from} = $from;
  84. $messages{lc($pseudo)}{is} = $memo;
  85. $messages{lc($pseudo)}{chan} = $to;
  86. }
  87.  
  88. sub salut() {
  89. my ($pseudo) = @_;
  90. &msgti($to,"Salut $pseudo");
  91. }
  92.  
  93. sub mute() {
  94. if($mute{$to}) { $mute{$to} = 0; &msgti($to,"Bavard");
  95.   } else { &msgti($to,"Muet"); $mute{$to} = 1;
  96.   }
  97. }
  98.  
  99. sub eucd() {
  100. &msgti($to,"Le projet DADVSI menace le Logiciel Libre ! Agissez en signant la pétition sur http://eucd.info/petitions/index.php?petition=2 .");
  101. }
  102.  
  103. sub wkp() {
  104. open (WIKI, "curl http://fr.wikipedia.org/wiki/Special:Statistics 2>/dev/null |");
  105.         while (<WIKI>){
  106.                 if($_ =~ m/^<p><big>La base de données de la <a href="\/wiki\/Wikip%C3%A9dia" title="Wikipédia">Wikipédia<\/a> francophone contient actuellement <b>([\d]*)([\d]{3,3})<\/b>/) {
  107.  &msgti($to,"$1 $2 articles sur http://fr.wikipedia.org/ , ".(200000 - ($1*10**3+$2))." avant les 200 000 !");
  108.        }
  109.        }
  110. close WIKI;
  111. }
  112.  
  113. # Log on to the server.
  114. print $sock "NICK $nick\r\n";
  115. print $sock "USER $login 8 * :Perl IRC Hacks Robot\r\n";
  116. # Read lines from the server until it tells us we have connected.
  117. while (my $input = <$sock>) {
  118.         # Check the numerical responses from the server.
  119.         if ($input =~ /004/) {
  120.         # We are now logged in.
  121.         print "Connecté\n";
  122.         last;
  123.         } elsif ($input =~ /433/) {
  124.                 die "Nickname is already in use.";
  125.         }
  126. }
  127.  
  128. # Join the channel.
  129. print $sock "JOIN $channel\r\n";
  130. print "$channel joint\n";
  131. my $top;
  132.  
  133. # Keep reading lines from the server.
  134. while (my $input = <$sock>) {
  135.         chop $input;
  136.         if ($input =~ /^PING(.*)$/i) {
  137.                 # We must respond to PINGs to avoid being disconnected.
  138.                 print $sock "PONG $1\r\n";
  139.         } elsif($input =~ /^:(.*)!.*\ PRIVMSG\ (\S+) :(.*)\r/) {
  140.                 $top = $3;
  141.                 $to = $2;
  142.                 $from = $1;
  143. #              print $to."-".$nick."\n";
  144. #              if($to eq $nick) {
  145. #                     print "\n";
  146. #              } els
  147.                 if(($admin{$from})and!($to =~ /#/)) {
  148.                         print $sock $top."\r\n";
  149.                 } else {
  150. #                     print "$to: <$from> $top\n";
  151.                         if($top =~ /^!(\S+)(\s+|)(\S+|)(\s+|)(\S+.*|)$/) {
  152.                                 $action = $1;
  153.                                 $arg[0] = $3;
  154.                                 $arg[1] = $5;
  155. #                            print "$action ".$arg[0]." ".$arg[1]."\n";
  156.                                 switch($action) {
  157.                                         case "list"     { &list(); }
  158.                                         case "time"     { &ctime(); }
  159.                                         case "stat"     { &stats(); }
  160.                                         case "query"    { &query($arg[0],$arg[1]); }
  161.                                         case "memo"     { &memo($arg[0],$arg[1]); }
  162.                                         case "last"     { &clast($arg[0]); }
  163.                                         case "salut"    { &salut($arg[0]); }
  164.                                         case "mute"     { &mute(); }
  165.                                         case "eucd"     { &eucd(); }
  166.                                         case "wkp"      { &wkp(); }
  167.                                 }
  168.                         }
  169.                 }
  170.         } elsif($input =~ /352/ ) {
  171.                 $nombre++;
  172.         } elsif($input =~ /315/ ) {
  173.                 &msgti($to,"$nombre $to");
  174.         } elsif($input =~ /:(.*)![in]=.* JOIN :(#\S+)/ ) {
  175. #              if(!($1 =~ /$nick/)) {
  176. #                     print $sock "PRIVMSG $channel :salut $1\r\n";
  177.                         if($messages{lc($1)}) {
  178.                                 print $sock "PRIVMSG ".$messages{lc($1)}{chan}." :$1, j'ai un message pour toi : \"".$messages{lc($1)}{is}."\" de la part de ".$messages{lc($1)}{from}."\r\n";
  179.                                 delete $messages{lc($1)};
  180. #                     }
  181.                 }
  182.         } elsif($input =~ /^:(.*)![in]=.* (PART|QUIT) (\S+ |):(.*)\r/){
  183. # print $input."\n";
  184.                 $quit{lc($1)}{date} = getdate();
  185.                 $quit{lc($1)}{raison} = $4;
  186.                 $quit{lc($1)}{chan} = $3;
  187. #print $quit{$1}." ".$
  188.         } elsif($input =~ /372/) {
  189.         } else {
  190. # print $input."\n";
  191.         }
  192. }
  • Valid Xhtml
  • Valid Css
  • OpenSource
  • Gentoo
  • Powered with Xname
  • Creative Commons