Openkore.com
http://forums.openkore.com/

Kadiliman Plugin v 1.3 - ChatBot by Kali
http://forums.openkore.com/viewtopic.php?f=34&t=22
Page 15 of 15

Author:  virulent [ 06 Feb 2015, 17:48 ]
Post subject:  Re: Kadiliman Plugin v 1.3 - ChatBot by Kali

cursedxxx wrote:
of the pm or pl? file or both?


both would help everyone

Author:  cursedxxx [ 07 Feb 2015, 17:58 ]
Post subject:  Re: Kadiliman Plugin v 1.3 - ChatBot by Kali

ok,hope you got more of a clue of what's going on :P
and thanks for the time mate

.pl file
Code:
    package kadiliman;

    #
    # This plugin is licensed under the GNU GPL
    # Copyright 2005 by kaliwanagan, now know as Kali
    # Ported by Thrice aka Noface
    # Adds by Mucilon
    # Version 1.3 - 03/04/2008
    # --------------------------------------------------
    #
    # How to install this thing..:
    #
    # in control\config.txt add:
    #
    #chatBot Kadiliman {
    #   inLockOnly 1      # (0|1) Just answer to public chat at lockmap, pm will be answered normally
    #       scriptfile lines.txt   # Name of the file where all sentences are storage, it will be create at openkore root directory
    #       replyRate 80      # (0..100) Rate to answer, 80 means: answer 80% of chats and don't answer 20%
    #       onPublicChat 1      # (0|1) Enable to answer any plublic chat
    #       onPrivateMessage 1   # (0|1) Enable to answer any private message
    #       onSystemChat 1      # (0|1) Enable to answer any system message
    #       onGuildChat 1      # (0|1) Enable to answer any guild chat
    #       onPartyChat 1      # (0|1) Enable to answer any party chat
    #       wpm 65         # Don't need to change - words per minute, simulate typing speed
    #       smileys ^_^,xD,^^,:),XD   # Smileys that may end your sentences on chat (separeted by commas)
    #       smileyRate 20      # Rate to add smiley to the sentences, means: add smileys to 20% of messages
    #       learn 1         # This plugin can "learn" every sentence read by the bot, this sentences are storage at the scriptfile
    #   noPlayers , ,      # Name of the players (supported by regexp) you don't want to answer any thing, like party members (separeted by commas)
    #   noWords  , , ,       # Words (supported by regexp) at the chats you don't want to answer, like "bot", "heal", "buffs" or something like this (separeted by commas)
    #   timesToBlockPM 10   # Number of times of pms received by each player to ignore him, work just to pm
    #   timeToResetCount 300   # Number of seconds to reset the count to ignore any player
    #}

    #This new add will ignore any player that send 10 or more pms to you in 300 seconds. But if he send 9 pms to you and the
    # count is reseted, he will need to send more 10 pms inside the 300 seconds to the plugin ignore him.
    #You can change this 2 last values as you like.

    use strict;
    use Plugins;
    use Globals;
    use Log qw(message warning error debug);
    use Misc;
    use Network;
    use Network::Send;
    use Network::Receive;
    use Chatbot::Kadiliman;
    use I18N qw(bytesToString);
    #use Utils;


    Plugins::register('kadiliman', 'autoresponse bot', \&Unload, \&Reload);
    my $hooks = Plugins::addHooks(
            ['packet/public_chat', \&onMessage, undef],
            ['packet/private_message', \&onMessage, undef],
            ['packet/system_chat', \&onMessage, undef],
            ['packet/guild_chat', \&onMessage, undef],
            ['packet/party_chat', \&onMessage, undef],
            ['start3', \&start3, undef],
            ['AI_post', \&AI_post, undef]
    );

    my $prefix = "chatBot_";
    my %bot;
    my %chatcountPrivate;
    my %chatcountPublic;
    my %Timecount;

    message "Initializing chatBot\n", "plugins";
    for (my $i = 0; (exists $config{$prefix.$i}); $i++) {
            $bot{$i} = new Chatbot::Kadiliman {
            };
    }

    sub Unload {
            Plugins::delHooks($hooks);
    }

sub Reload {
        for (my $i = 0; (exists $config{$prefix.$i}); $i++) {
                message "Plugin Kadiliman: checking for duplicate lines in ". $config{$prefix.$i."_scriptfile"} ."...", "plugins";
#                checkForDupes($config{$prefix.$i."_scriptfile"});
                message "[Kadiliman] done.\n", "plugins";
                $bot{$i} = new Chatbot::Kadiliman {
                        name        => $config{$prefix.$i},
                        scriptfile      => $config{$prefix.$i."_scriptfile"},
                        learn      => $config{$prefix.$i."_learn"},
                        reply      => 1,
                };
        }
}

    sub onMessage {
            my ($packet, $args) = @_;
            my $prefix = "chatBot_";

            for (my $i = 0; (exists $config{$prefix.$i}); $i++) {
          #Don't answer, case it is the own message
          my $msg = $args->{message};
                    my ($chatMsgUser, $chatMsg);
               
          if ($msg =~/:/) {
                            ($chatMsgUser, $chatMsg) = $msg =~ /(.*?).:.(.*)/;
                    } else {
                            $chatMsg = $msg;
                    }
                    return if ($chatMsgUser eq $char->{name});
               
          #Don't answer the player, if he is at _noPlayers from config file
          my @noplayers = split /\s*\,+\s*/, $config{$prefix.$i."_noPlayers"};
          foreach my $player (@noplayers) {
                if ((match($player,$chatMsgUser)) || (match($player,$args->{privMsgUser}))){
                   message "[Kadiliman] Don't answering player $player\n", "plugins";
                   return 1;
                }
          }
         
          #Message Count         
          if ($packet eq 'packet/public_chat') {
                $chatcountPublic{$i}{$chatMsgUser}++;
                message "[Kadiliman] Player $chatMsgUser has spoken on public chat $chatcountPublic{$i}{$chatMsgUser} time(s)\n", "plugins";
                    } elsif ($packet eq 'packet/private_message') {
                my $pmuser = $args->{privMsgUser};
                $chatcountPrivate{$i}{$pmuser}++;
                message "[Kadiliman] Player $pmuser has spoken on PM $chatcountPrivate{$i}{$pmuser} time(s)\n", "plugins";
                if (($chatcountPrivate{$i}{$pmuser} >= $config{$prefix.$i."_timesToBlockPM"}) && ($config{$prefix.$i."_timesToBlockPM"} > 0)) {
                      Commands::cmdIgnore "ignore","1 $pmuser";
                }
                    }
         
          #Don't answer the player, if some word of the message is at _noWords from config file
          my @nowords = split /\s*\,+\s*/, $config{$prefix.$i."_noWords"};
          foreach my $word (@nowords) {
                if (match($word,$chatMsg)){
                   message "[Kadiliman] Don't answering message with word: $word\n", "plugins";
                   return 1;
                }
          }
               
                    $bot{$i}->{reply} = ($config{$prefix.$i."_replyRate"}) ? 1 : 0;
                    $config{$prefix.$i."_replyRate"} = 80 if (!exists $config{$prefix.$i."_replyRate"});
                    $config{$prefix.$i."_replyRate"} = 100 if ($config{$prefix.$i."_replyRate"} > 100);

                    my $type;
                    my $reply;

                    if ($packet eq 'packet/public_chat' && $config{$prefix.$i."_onPublicChat"}) {
             #return if bot isn't at lockmap
             return if (($config{$prefix.$i."_inLockOnly"} > 0) && ($field->baseName ne $config{lockMap}));
             $reply = $bot{$i}->transform($chatMsg);
                            $type = "c";
                    } elsif ($packet eq 'packet/system_chat' && $config{$prefix.$i."_onSystemChat"}) {
             $reply = $bot{$i}->transform();
                            $type = "c";
                    } elsif ($packet eq 'packet/guild_chat' && $config{$prefix.$i."_onGuildChat"}) {
                            $reply = $bot{$i}->transform($chatMsg);
                            $type = "g";
                    } elsif ($packet eq 'packet/party_chat' && $config{$prefix.$i."_onPartyChat"}) {
                            $reply = $bot{$i}->transform($chatMsg);
                            $type = "p";
                    } elsif ($packet eq 'packet/private_message' && $config{$prefix.$i."_onPrivateMessage"}) {
                            $reply = $bot{$i}->transform($args->{privMsg});
                            $type = "pm";
                    }


                    # exit if the config option is not enabled
                    return if (!$type);

                    # exit if we don't have any reply
                    return if (!$reply);

                    # add a smiley at the end of the reply
                    my @smileys = split /\,+/, $config{$prefix.$i."_smileys"};
                    $reply .= $smileys[rand(@smileys)] if ((rand(100) < ($config{$prefix.$i."_smileyRate"})));

                    ## COPIED FROM processChatResponse, ChatQueue.pm
                    # Calculate a small delay (to simulate typing)
                    # The average typing speed is 65 words per minute.
                    # The average length of a word used by RO players is 4.25 characters (yes I measured it).
                    # So the average user types 65 * 4.25 = 276.25 charcters per minute, or
                    # 276.25 / 60 = 4.6042 characters per second
                    # We also add a random delay of 0.5-1.5 seconds.
                    $args->{wpm} = $config{$prefix.$i."_wpm"} || 65;
                    my @words = split /\s+/, $reply;
                    my $average;
                    foreach my $word (@words) {
                            $average += length($word);
                    }
                    $average /= (scalar @words);
                    my $typeSpeed = $args->{wpm} * $average / 60;

                    $args->{timeout} = (0.5 + rand(1)) + (length($reply) / $typeSpeed);
                    $args->{time} = time;
                    $args->{stage} = "start";
                    $args->{reply} = $reply;
                    $args->{prefix} = $prefix.$i;
                    $args->{type} = $type;
                    my $rand = rand(100);
                    debug "[Kadiliman] $rand: " . $config{$prefix.$i."_replyRate"} . "\n";
                    AI::queue("chatBot", $args)
                            if ((AI::action ne 'chatBot')
                                    && ($rand < ($config{$prefix.$i."_replyRate"}))
                                    && ($bot{$i}->{reply})
                                    && (main::checkSelfCondition($prefix))
                            );
            }
    }

    sub start3 {
            for (my $i = 0; (exists $config{$prefix.$i}); $i++) {
                    #message "Plugin Kadiliman: checking for duplicate lines in ". $config{$prefix.$i."_scriptfile"} ."...", "plugins";
                    #checkForDupes($config{$prefix.$i."_scriptfile"});
                    message "[Kadiliman] done.\n", "plugins";
                    $bot{$i} = new Chatbot::Kadiliman {
                            name        => $config{$prefix.$i},
                            scriptfile      => $config{$prefix.$i."_scriptfile"},
                            learn      => $config{$prefix.$i."_learn"},
                            reply      => 1,
                    };
            }
    }

    sub AI_post {
            if (AI::action eq 'chatBot') {
                    my $args = AI::args;
                    if ($args->{stage} eq 'end') {
                            AI::dequeue;
                    } elsif ($args->{stage} eq 'start') {
                            $args->{stage} = 'message' if (main::timeOut($args->{time}, $args->{timeout}));
                    } elsif ($args->{stage} eq 'message') {
                            sendMessage($messageSender, $args->{type}, $args->{reply}, $args->{privMsgUser});
                            debug "[Kadiliman] chatBot: $args->{reply}\n", "plugins";
                            $args->{stage} = 'end';
                    }
            }
          #Time to reset the message count (loopless code)
          for (my $i = 0; (exists $config{$prefix.$i}); $i++) {
                if ($Timecount{$i}{start} eq ''){
                      $Timecount{$i}{start} = time;
                      debug "[Kadiliman] start: $Timecount{$i}{start}\n", "plugins";
                }
                $Timecount{$i}{current} = time;

                $Timecount{$i}{toreset} = $config{$prefix.$i."_timeToResetCount"};
                if (($Timecount{$i}{toreset} ne '') || ($Timecount{$i}{toreset} > 0)) {
                      $Timecount{$i}{after} = $Timecount{$i}{start} + $Timecount{$i}{toreset};
                      if ($Timecount{$i}{current} >= $Timecount{$i}{after}){
                            #message "[Kadiliman] Reseted, start: $Timecount{$i}{start}, time now: $Timecount{$i}{current}, next: $Timecount{$i}{after}, time to count: $Timecount{$i}{toreset}\n", "plugins";
                            message "[Kadiliman] Chat count reseted, next in $Timecount{$i}{toreset} secs\n", "plugins";
                            $Timecount{$i}{start} = time;
                            delete $chatcountPublic{$i};
                            delete $chatcountPrivate{$i};
                      }
                }
          }
    }


    sub match
    {
            my ($pattern,$subject) = @_;
            if (my ($re, $ci) = $pattern =~ /^\/(.+?)\/(i?)$/)
            {       
                    if (($ci && $subject =~ /$re/i) || (!$ci && $subject =~ /$re/))
                    {
                            return 1;
                    }
            }
            elsif ($subject eq $pattern)
            {
                    return 1;
            }
            return 0;
    }


    sub checkForDupes {
            my $scriptfile = shift;
            my %self;

            $scriptfile = "lines.txt" if ($scriptfile eq 1);

            # read scriptfile in (the whole thing, all at once).
            my @scriptlines;
            if (open (SCRIPTFILE, "<$scriptfile")) {
                    @scriptlines = <SCRIPTFILE>; # read in script data
                    close (SCRIPTFILE);
            }

            # check for duplicate lines
            for (my $i = 0; $i < (scalar @scriptlines); $i++) {
                    for (my $j = $i + 1; $j < (scalar @scriptlines); $j++) {
                            $scriptlines[$i] = '' if ($scriptlines[$i] eq $scriptlines[$j]);
                    }
            }

            # save cleaned-up file
            open (SCRIPTFILE, ">$scriptfile");
            foreach my $line (@scriptlines) {
                    print SCRIPTFILE ("$line");
            }
            close (SCRIPTFILE);
    }

    return 1;



.pm file
Code:
# Inspired by perlBorg, pyBorg, and seeBorg
# Licensed under the GPL
# Copyright by kaliwanagan
# Ported by Thrice aka Noface

package Chatbot::Kadiliman;

use strict;
use Log qw(message warning error);
use vars qw($VERSION @ISA $AUTOLOAD) ;

$VERSION = '0.06';
sub Version { $VERSION; }

my $fields;

$fields = {
      name            => 'Kadiliman',
      scriptfile            => '',
      depth         => 3,
      learn         => 1,
      reply         => 1,
      debug         => 1,
      debug_text            => '',
      quit            => undef
};

sub new {
      my ($that, $name, $scriptfile) = @_;
      my $class = ref($that) || $that;
      my $self = {
            _permitted => \$fields,
            $fields,
      };

      bless $self, $class;
      $self->_initialize($name, $scriptfile);
      return $self;
}

sub _initialize {
      my ($self, $name, $scriptfile) = @_;

      if (defined $name and ref $name eq "HASH") {

            # Allow the calling program to pass in intial parameters
            # as an anonymous hash
            map { $self->{$_} = $name->{$_}; } keys %$name;

            $self->parseScriptData( $self->{scriptfile} );

      } else {
            $self->{name} = $name if $name;
            $self->parseScriptData($scriptfile);
      }
}

sub parseScriptData {
      my ($self, $scriptfile) = @_;

      $self->debug("Parsing $scriptfile... ");
      my @scriptlines;
      if ($scriptfile) {
            # If we have an external script file, open it
            # and read it in (the whole thing, all at once).
            if (open (SCRIPTFILE, "<$scriptfile")) {
                  @scriptlines = <SCRIPTFILE>; # read in script data
                  $self->{scriptfile} = $scriptfile;
                  close (SCRIPTFILE);
            } else {
                  print "Could not read from file $scriptfile : $!\n";
                  print "Creating default lines.txt ...\n";
                  $self->{scriptfile} = "lines.txt";
            }
            $self->debug("done\n");
      }
      $self->debug("Parse Learning $scriptfile... ");
      foreach my $line (@scriptlines) {
            my @sentences = split /\.+/, $line;
            foreach my $sentence (@sentences) {
                  $self->learn($sentence);
            }
      }
      $self->debug("done\n");
     $self->debug("I know ". scalar @{$self->{lines}} . " lines.\n") if (exists $self->{lines});
      message "[Kadiliman] I know ". scalar @{$self->{lines}} . " lines.\n", "plugins" if (exists $self->{lines});
     $self->{parsed} = 1;
}

sub saveScriptData {
      my ($self) = @_;

      $self->debug("Saving script data... ");
     my $scriptfile = $self->{scriptfile};
      open (SCRIPTFILE, ">$scriptfile");
      foreach my $line (@{$self->{lines}}) {
            print SCRIPTFILE ("$line\n");
         $self->debug("$line\n");
      }
      close (SCRIPTFILE);
      $self->debug("done.\n");
}

sub learn {
      my ($self, $string) = @_;
      my $numLines = (exists $self->{lines}) ? @{$self->{lines}} : '0';

      $string = $self->preProcess($string);
      my $tmp = $string;
    
      $tmp = lc $tmp; # convert to lowercase
      $tmp =~ s/[^A-Za-z_0-9 \']/ /g; # remove non alpha-numeric characters
      my @words = split /\s+/, $tmp;
      for (my $i = 0; $i < scalar @words; $i++) {
            $self->{count}{$words[$i]}++;
            $self->{after}{$words[$i]}{$words[$i+1]}++ if ($words[$i+1]);
            push @{$self->{linenum}{$words[$i]}}, $numLines;
      }
      push @{$self->{lines}}, $string if ($string);
      if ($self->{parsed}) {
            $self->debug("Learn Learning: $string\n");
         message "[Kadiliman] Learning: $string\n", "plugins";
      }
}

sub preProcess {
      my ($self, $string) = @_;
      $string =~ s/\n//g; # remove newlines
      $string =~ s/\r//g; # remove cariage returns;
      $string =~ s/^_*//; #remove leading underscores
      $string =~ s/_*$//; #remove trailing underscores
      $string =~ s/^\s*//; #remove leading spaces
      $string =~ s/\s*$//; #remove trailing spaces

      return $string;
}

sub postProcess {
      my ($self, $string) = @_;
}

sub transform {
      my ($self, $inputString) = @_;
      my $reply;
      my $input = $self->preProcess($inputString);
    
      # Filter out all the words we haven't learned yet
      my @leftWords;
      $input = lc $input; # convert to lowercase
      $input =~ s/[^A-Za-z_0-9 \']/ /g; # remove non alpha-numeric characters
      my @words = split /\s+/, $input;
      foreach my $word (@words) {
            $self->debug("$word: $self->{count}{$word}\n");
            next if (!exists ($self->{count}{$word}));
            push @leftWords, $word;
      }
      undef @words;

      # Choose a word from the list of known words
      my $leftWord = $leftWords[int rand(@leftWords)];
      $self->debug("Chosen left word: $leftWord\n");
      undef @leftWords;

      if (!$leftWord) { # if all words are unknown
            $reply = $self->{lines}[int rand(@{$self->{lines}})];
      } else {

            my @rightWords = keys %{$self->{after}{$leftWord}};
            my $rightWord = $rightWords[int rand(@rightWords)];
            $self->debug("Chosen right word: $rightWord\n");
            undef @rightWords;

            my @leftLines;
            my @rightLines;
            my $string;

            # Cull from script data all lines containing the left word
            foreach my $linenum (@{$self->{linenum}{$leftWord}}) {
                  push @leftLines, $self->{lines}[$linenum];
            }

            $self->debug("leftLines: " . scalar @leftLines . "\n");

            # Cull from script data all lines containing the right word
            foreach my $linenum (@{$self->{linenum}{$rightWord}}) {
                  push @rightLines, $self->{lines}[$linenum];
            }

            $self->debug("rightLines: " . scalar @rightLines . "\n");
         
            my $rand;

            # Get a random line from those that contain the left word
            $rand = int rand(@leftLines);
            $string = $leftLines[$rand];

            # Build the left side
            my $leftSide;

            my @words = split /\s+/, $string;
            foreach my $word (@words) {
                  $leftSide = $leftSide . $word . ' ';
                  last if $word =~ /\b$leftWord\b/;
            }
            undef @words;
            $self->debug("Leftside: $leftSide line: $rand\n");
         
            # Get a random line from those that contain the right word
            $rand = int rand(@rightLines);
            $string = $rightLines[$rand];

            # Build the right side
            my $rightSide;

            my @words = split /\s+/, $string;
            foreach my $word (@words) {
                  last if $word =~ /\b$rightWord\b/;
                  $word = '';
            }
            foreach my $word (@words) {
                  $rightSide .= $word ? $word . ' ' : '';
            }
            undef @words;
            $self->debug("Rightside: $rightSide line: $rand\n");
         
            # Build the reply
            $reply = $leftSide . $rightSide;
      }
      $self->learn($inputString) if ($self->{learn});
      $self->saveScriptData if ($self->{learn});
      return $reply;
}

sub _testquit {
      my ($self, $string) = @_;
      return 1 if ($string =~ /\bquit\b/i);
}

sub command_interface {
      my $self = shift;
      my $userInput;
      while (1) {
            chomp($userInput = <STDIN>);
            if($self->_testquit($userInput)) {
                  last;
            }
            print "Reply: ".$self->transform($userInput)."\n";
      }
}

sub debug {
      my ($self,$string) = @_;
      message "[Kadiliman] $string\n", "plugins" if ($self->{debug});
}

return 1;

=head1 CHANGES

=over 4

= item * Version 0.06 (21 July 2005)

fix for regexp dying on unescaped characters (thanks Joseph)

= item * Version 0.05 (18 July 2005)

changed from a simple word selection into word + wordafter selection

= item * Version 0.04 (17 July 2005)

First release

= item * Version 0.03 (17 July 2005)

complete learn and transform functions
changed from rare word to random word selection

= item * Version 0.02 (15 July 2005)

preProcess function
learn function (partial)
transform function (partial)

= item * Version 0.01 (8 July 2005)

Created skeleton code

=back

=cut

Author:  michaelmyc [ 04 Dec 2017, 13:01 ]
Post subject:  Re: Kadiliman Plugin v 1.3 - ChatBot by Kali

Hi i'm getting this error. any idea what it means?

OpenKore version what-will-become-2.1
@ai_seq = chatBot route
Network state = 5
Network handler = Network::XKore
Revision: ctime:2017_12_04
Loaded plugins:
plugins/breakTime/breakTime.pl (breakTime; description: Automatically disconnect and reconnect at certain times of the day)
plugins/eventMacro/eventMacro.pl (eventMacro; description: allows usage of eventMacros)
plugins/item_weight_recorder/item_weight_recorder.pl (item_weight_recorder; description: item_weight_recorder plugin)
plugins/kadiliman.pl (kadiliman; description: autoresponse bot)
plugins/macro/macro.pl (macro; description: allows usage of macros)
plugins/map/map.pl (map; description: map)
plugins/profiles/profiles.pl (profiles; description: Profiles Selector)
plugins/raiseSkill/raiseSkill.pl (raiseSkill; description: automatically raise character skills)
plugins/raiseStat/raiseStat.pl (raiseStat; description: automatically raise character stats)
plugins/reconnect/reconnect.pl (reconnect; description: v1.0)

Error message:
Can't locate object method "sendPrivateMsg" via package "Network::XKore" at src/Misc.pm line 2491.

Stack trace:
Can't locate object method "sendPrivateMsg" via package "Network::XKore" at src/Misc.pm line 2491.
at src/Misc.pm line 2491
Misc::sendMessage_send('Network::XKore=HASH(0x87eb334)', 'pm', 'are you a bot? ^_^', 'Dornish') called at src/Misc.pm line 2467
Misc::sendMessage('Network::XKore=HASH(0x87eb334)', 'pm', 'are you a bot? ^_^', 'Dornish') called at C:/Users/michaelmyc/Downloads/Ragnarok/michaelmyc/plugins/kadiliman.pl line 175
kadiliman::AI_post('AI_post', undef, undef) called at src/Plugins.pm line 434
Plugins::callHook('AI_post') called at src/AI/CoreLogic.pm line 212
AI::CoreLogic::iterate() called at src/functions.pl line 770
main::mainLoop_initialized() called at src/functions.pl line 75
main::mainLoop() called at src/Interface.pm line 75
Interface::mainLoop('Interface::Console::Win32=HASH(0x6a049f4)') called at openkore.pl line 97
main::__start() called at start.pl line 136

Died at this line:
push @lastpm, {%lastpm} if ($user !~ '#\w+');
* $sender->sendPrivateMsg($user, $msg);
} elsif ($type eq "k") {

Author:  Mortimal [ 11 Dec 2017, 04:31 ]
Post subject:  Re: Kadiliman Plugin v 1.3 - ChatBot by Kali

This plugin is outdated... need to be reviewed

Page 15 of 15 All times are UTC - 5 hours [ DST ]
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group
http://www.phpbb.com/