BEBot

#!/usr/bin/perl

use strict;
use warnings;

package MyBot;
use base qw( Bot::BasicBot );
use Time::HiRes qw( gettimeofday );
use Net::INET6Glue::INET_is_INET6 ;
use LWP::UserAgent;

# server configuration
my $server   = 'irc.freenode.net';
my $nickname = 'BEBot';
my $channel = '#breizh-entropy';

#on charge le fichier au demarrage
load_fortune('classe.fortune');

############# LOAD ############

sub load_fortune
{
  my ($file) = @_;
  open(IN, "<$file") or die "can't open file\n";
  srand( time ^ $$ );
} 

########### HOOK FUNCTION ####

sub said
{
  my ($self, $message) = @_;

  TXT: {

    # PUBLIC COMMANDE 
    if(($message->{body} =~ /^\!\S+.*$/)) {
      on_public_command($self, $message);
      last TXT;
    }

    # LIEN
    # (https?|ftp):\/\/([0-9a-zA-Z][-\w]*[0-9a-zA-Z]\.)+[a-zA-Z]{2,9})(:\d{1,4})?([-\w\/#~:.?+=&%@~]*)/")
    if($message->{body} =~ m/^.*?(https?:\/\/\S+).*$/){
      on_public_link($self, $message, $1);
      last TXT;
    }elsif($message->{body} =~ m/^.*?(www\.\S+).*$/){
      on_public_link($self, $message, $1);
      last TXT;
    }

  }
  return undef;
}

sub on_public_command 
{
  my($self, $message) = @_;
  if( $message->{body} =~ m/^(\!\S+)\s*(.*)$/ ){
    if($1 eq '!classe'){ on_command_classe($self, $2, $message); }
  }
}

########### LINK PREVIEW  ####

sub on_public_link
{
  my($self, $message, $link) = @_;
  my $ua  = LWP::UserAgent->new();
  my $req = HTTP::Request->new( GET => $link );
  my $res = $ua->request($req);
  if( $res->is_success ){
    my $title = "";   
    if( $link =~ m/^.*?\.(jpe?g|png|gif)$/i ){
      $title = "image";
    }else{
      $title = "title : ".$res->title;
    }
    $self->say(
      channel => $message->{channel},
      body => substr "[Link Info] $title", 0, 200
    );
  }else{
   $self->say(
     channel => $message->{channel},
     body => "[Link Error] ".$res->status_line
     );
  }
}


########### LA CLASSE AMERICAINE  ####


sub on_command_classe 
{
  my($self, $arg, $message) = @_;
  if($arg eq ""){
    # selection aléatoire
    seek (IN, 0, 0);  
    my $linenb = int(rand(473));
    my $line = "";
    while(($linenb > 0) || ($line ne '%')){ $linenb--; $line = <IN>; chomp($line);}
    $line = <IN>;
    do{
      $self->say(
        channel => $message->{channel},
        body => $line 
      );
      $line = <IN>;   
      chomp($line);   
    }while ($line  ne '%');
  }else{
    # premier qui match
    seek (IN, 0, 0);  
    my $linenb = 0;   
    my $find = 0;
    my @lines = ();   
    while(($linenb < 473) && ($find == 0)){
      my $line = "";  
      @lines = ();
      while($line ne '%'){
        $line = <IN>; chomp($line); $linenb++;
        if($line ne '%'){ push(@lines, $line); }
        if($line =~ m/^.*?$arg.*$/i){ $find = 1; }
      }
    }
    if($find == 1){   
      foreach (@lines){
        chomp($_);
        $self->say(   
          channel => $message->{channel},
          body => $_  
        );
      }
    }else{
        $self->say(   
          channel => $message->{channel},
          body => $message->{who}.": extrait non trouvé.. :("
        );
    }
  }
}

MyBot->new(
  server => $server,  
  channels => [ $channel ],
  nick => $nickname,  
  alt_nicks =>["BEBot_","BEBot__"],
  charset => "iso-8859-15"
)->run();