From cd7d23ef9af3ba06e20afe73119a5e43232a565a Mon Sep 17 00:00:00 2001
From: Someone <someone@somenet.org>
Date: Sat, 19 Mar 2011 01:48:44 +0100
Subject: [PATCH] newline-user fix
---
ChangeLog.txt | 651 ++++++++++++++
README | 62 ++
bot.v3.1.2.pl | 2353 +++++++++++++++++++++++++++++++++++++++++++++++++
events.txt | 71 ++
irpgdbtool | 469 ++++++++++
5 files changed, 3606 insertions(+)
create mode 100644 ChangeLog.txt
create mode 100644 README
create mode 100644 bot.v3.1.2.pl
create mode 100644 events.txt
create mode 100644 irpgdbtool
diff --git a/ChangeLog.txt b/ChangeLog.txt
new file mode 100644
index 0000000..2985918
--- /dev/null
+++ b/ChangeLog.txt
@@ -0,0 +1,651 @@
+This is the changelog for the Idle RPG bot by jotun, jotun@idlerpg.net,
+http://idlerpg.net. Entries are written backwards. That is, items at the bottom
+of the file were added first, and each subsequent addition is placed on a line
+before it. Don't ask me why I do it that way: I do not know.
+
+Thanks for your interest in the Idle RPG! Feel free to contact me with ideas and
+comments, or post them in the forum on the website for public view.
+
+--------------------------------------------------------------------------------
+ v3.1.2: released 6/6/04
+--------------------------------------------------------------------------------
+ - applied a user-submitted patch to fix a sprintf() bug (anonymous @ forum)
+ - quest() now calls writequestfile() when it completes
+ - loaddb() now calls backup() before it starts
+
+
+--------------------------------------------------------------------------------
+ v3.1.1: released 6/3/04
+--------------------------------------------------------------------------------
+ - fixed 2 typos having to deal with die() messages when reading the config
+ file (meij, et al)
+ - quest() now calls writequestfile() when it completes so that it is
+ immediately available
+ - loaddb() now calls backup() before it starts so you always have an
+ up-to-date backup if your bot mangles your db
+ - readconfig() now strips out \r and \n (meij, kylemson, et al)
+
+
+--------------------------------------------------------------------------------
+ v3.1.0: released 6/2/04
+--------------------------------------------------------------------------------
+ - added a config file so you don't have to re-setup configuration options
+ everytime you upgrade. added a function readconfig() to read this file or
+ die() if it cannot be found
+ - SIGHUP will now call readconfig()
+ - added a DELADMIN command to remove admin status from a username. format:
+ /msg bot DELADMIN <account>
+ owner account cannot be DELADMINed. DELADMIN may be limited to owner account
+ depending on configuration (TGS)
+ - added an 'owner' account option. owner cannot be DELADMINed, among other
+ things
+ - added an 'owneraddonly' option. if set, only owner account can MKADMIN
+ - added an 'ownerdelonly' option. if set, only owner account can DELADMIN
+ - renamed disablepeval to ownerpevalonly. if set, only owner account can PEVAL
+ - added missing command line options for %opts options
+ - fq() will limit itself to either 1 message or <= 768 bytes output per call,
+ regardless of $freemessages
+ - added an option to turn off the sending of the list of users automatically
+ logged back in on a bot restart, even if the list < 1 k
+ - added an option to limit the penalty a single event can incur, 'limitpen'.
+ set to 0 to disable the feature, otherwise is taken to be an integral number
+ of seconds
+ - Win32 no longer tries to turn terminal echo on/off via "stty"
+ - tarball now unpacks files to their own directory instead of .
+ - removed unused $v, $debug variables
+ - auto-login would not voice users that it logged in even if voiceonlogin was
+ set, fixed (wogi, et al)
+ - fixed a comment having to do with auto login
+ - $rpreport should not have been adjusted by $curtime, but by
+ $opts{self_clock} to keep it reliable. this may have caused some loss of
+ data as the bot neglected to properly backup its database. so sorry! should
+ now be fixed (many)
+ - item godsend was removing 10% of item's value instead of adding it. another
+ copy/paste error. sorry! (Jim Dew)
+ - fixed a bug that resulted in users that caused quests to fail not being
+ penalized, as they were set as 'offline' before the bot had a chance to
+ penalize them (Jim Dew)
+ - added options to define the size of your IRPG grid, 'mapx' and 'mapy' (Rick)
+ - team battle now shows roll/sum like other battles (anonymous @ forum)
+ - added REHASH command to call readconfig()
+ - added an option to define the number of modes per line to use when voicing
+ users after an auto login. this variable may be overriden by the server's
+ directive (Rick)
+
+
+--------------------------------------------------------------------------------
+ v3.0.2: released 5/30/04
+--------------------------------------------------------------------------------
+ - calls evilness() and goodness() should have been checking against the number
+ of online evil users and good users respectively, not the total number of
+ online users (SickMind)
+ - changed max length of auto-login text to 1k before bot will refuse to send
+ - fixed a problem with the bot penalizing the kicker instead of the kickee
+ when someone was kicked (Preston, anonymous, Soc @ idlerpg.net forum)
+
+
+--------------------------------------------------------------------------------
+ v3.0.1: released 5/29/04
+--------------------------------------------------------------------------------
+ - forgot to add some sort of mechanism for setting up admins for new bots.
+ whoops. bot will now prompt for an owner's account details if it cannot find
+ $opts{dbfile} (Secret, anonymous @ idlerpg.net forum)
+ - fixed a typo in the ChangeLog ;)
+ - Vayanla noted that there was STILL a time discrepancy for very large games
+ (or very slow computers). many thanks to him for his help! this is now
+ fixed
+
+--------------------------------------------------------------------------------
+ v3.0: released 5/29/04
+--------------------------------------------------------------------------------
+ - fixed a bug causing RESTART not to work unless the bot's filename happened
+ to be the same as its nickname
+ - item modifiers as well as time modifiers are now stored in the modifiers
+ file. changed name of tlog sub to clog (time -> character)
+ - changed database write to every minute instead of every $opts{self_clock}.
+ to lower the chance of lost stats, the bot calls writedb() if you request a
+ DIE, JUMP, or RESTART. this should cut down on much of the cpu usage
+ - added a function writedb() which writes out the bot's db from memory so it
+ can be done outside of rpcheck()
+ - the team battle code would choose 6 random users to participate in a team
+ battle, but would not then randomize these users as far as teams go. that
+ is, if a username generally appeared at the end of a keys(%rps) list, and
+ made it into the list of 6 random users, that user would always defend
+ instead of attacking, as he would be at the end of the list. the list of 6
+ users is now shuffled using a Fisher-Yates shuffle, code from The Perl
+ Cookbook (by O'Reilly. a really great read!) (Peter Beentje)
+ - added a "user alignment" feature. users may align with good, neutral, or
+ evil. 'good' users have a 10% boost to their item sum for battles, and a
+ 1/12 chance each day that they, along with a 'good' friend, will have the
+ light of their god shine upon them, accelerating them 5-12% toward their
+ next level. 'evil' users have a 10% detriment to their item sum for battles
+ (ever forsaken in their time of most need...), but have a 1/8 chance each
+ day that they will either a) attempt to steal an item from a 'good' user
+ (whom they cannot help but hate) or b) be forsaken (for 1-5% of their TTL)
+ by their evil god. after all, we all know that crime doesn't pay. also,
+ 'good' users have only a 1/50 chance of landing a critical strike when
+ battling, while 'evil' users (who always fight dirty) have a 1/20 chance.
+ neutral users haven't had anything changed, and all users start off as
+ neutral. to change your alignment:
+ /msg bot ALIGN <good|neutral|evil>
+ I haven't run the numbers to see which alignment it is better to follow, so
+ the stats for this feature may change in the future (FishyTowel @
+ idlerpg.net forum)
+ - added new item, Juliet's Glorious Ring of Sparkliness, item level 50-74,
+ required user level 25+, chance 1/40, tag 'h'
+ - rather than error when PEVAL produces > 15 lines of output, PEVAL will now
+ queue its text if lines of output created >= 4 or size of text > 1k
+ - LOGIN command now responds via notice rather than privmsg
+ - added "named items," meaning that unique items have a letter appended to
+ them, saying which unique item they are. Mattt's Omniscience Grand Crown is
+ "a," Res0's Protectorate Plate Mail is "b," Dwyn's Storm Magic Amulet is
+ "c," Jotun's Fury Colossal Sword is "d," Drdink's Cane of Blind Rage is "e,"
+ Mrquick's Magical Boots of Swiftness is "f," and Jeff's Cluehammer of Doom
+ is "g"
+ - changed split() on incoming data to split on /\s/ instead of / /; users
+ could otherwise register usernames or classes containing tabs, which would
+ cause the bot to die when reading the (tab-delimited) database (chris young)
+ - changed the SIGHUP handler from '0' to 'sub { };'. should eliminate the
+ "Signal handler '0' not defined" warning (too many to list)
+ - added an item calamity and an item godsend. if you are calamitized, you have
+ a 10% chance of one of your amulet, charm, weapon, tunic, set of leggings,
+ or shield losing 10% of its item value. if you are godsent, you have a 10%
+ chance that one of the above items will gain 10% of its item value (carl
+ wyles @ idlerpg.net forum)
+ - %botnick% in $opts{botopcmd} will be evaluated to the bot's current nickname
+ to avoid opping another, more evil user when the bot's nickname is in use
+ - added an option to give non-admin users limited access to the INFO command.
+ when enabled, non-admin users can use the INFO command to learn to which
+ server the bot is connected and the nicknames of online admins (mike @
+ idlerpg.net forum)
+ - added an option to disallow the registration of usernames and classes
+ containing "non-printable" characters. it's a good idea to leave this option
+ on, as I have had problems in the past with using binary hash keys (TGS)
+ - whenever a non-admin players walks over an admin player on the map, he/she
+ has a 1% chance to bow ;) (mike stewart)
+ - changed sending of WHO and $opts{botopcmd} from numeric 001 to receipt of
+ bot's JOIN
+ - added an option to disable the PEVAL command for users that want to have
+ less than trustworthy admins ;^) (TGS)
+ - Run noted that (undernet?) servers allow you a certain number of "free"
+ messages before output should be limited to 1 message / 2 seconds. fq() now
+ sends as many of these "free" messages as it can, rather than sending only
+ one message per call (Run)
+ - removed some odd sts("MODE $opts{botchan}"); -- not sure why i put that in
+ - added rudimentary netsplit detection, which a) gives no penalty and b) logs
+ users in upon return. will pick up quit messages that match
+ /^\S+\.\S+ \S+\.\S+$/. if your network (or server) does not prefix quit
+ messages with "Quit: " (or some other string), or otherwise disallows faked
+ netsplit quit messages, then users can cheat this at their whim. added
+ option to turn netsplit detection on or off. added option of how long to
+ wait before automatically logging split users out and forgetting they ever
+ existed. added sub checksplits() which will iterate over the list of split
+ nick!user@hosts, remove those which have expired ($opts{splitwait}), and log
+ the user out. would love input on this feature, as i expect bugs
+ - HELP command for non-admins is now less helpful. generates one line of text
+ containing URL for help
+ - attempting to PUSH a user more than their TTL now sets their TTL to 0 as
+ well as generating a notice to the admin. successful PUSH now only
+ chanmsg()s instead of chanmsg()ing and privmsg()ing the admin
+ - $arg[3] changed to lowercased, leading-:-stripped $arg[3] in privmsg block
+ - cleaned up more code. changed (most) elses elsifs where appropriate. cleaned
+ up some logic. dropped all uses of next(). attempted to add () to function
+ calls wherever it was missing
+ - private messages and notices to the bot no longer penalize you (mrChewie)
+ - changed ha() to find access by username instead of nickname
+ - added a finduser() sub to return a logged-in username matching a given
+ nickname.
+ - changed case of $arg[1] after PONG rather than lc()ing it for every
+ comparison (mrChewie)
+ - at least 15% of all online players must be level 45+ for the hourly battle
+ of a level 45+ player to occur (anonymous @ idlerpg.net forum)
+ - fixed a serious bug with the bot not tracking changes to its nick (ie, by
+ NickServ or PEVAL) -- this caused all messages sent to the bot to be
+ penalized (TGS)
+ - added $opts{casematters}, which, when set, will not allow the registration
+ of usernames that already exist in a different case (MeBeHere)
+ - changed db backup, top players report to every 10 hours
+ - added $opts{modsfile}, which is where Time Modifier texts are appended.
+ also, tlog() now debug()s and chanmsg()s an error message if it cannot open
+ the file (MeBeHere)
+ - HOG was only 5-74%, corrected to 5-75% of TTL
+ - added an option $opts{self_clock} which is rather like the old $alrmint var,
+ except this probably works without exploding if you change it. calamities,
+ godsends, etc. should take this number into account when calculating odds
+ - added a server list rather than static server. bot should try each server in
+ the server list twice before giving up (meij)
+ - added a PID filename option, to which the bot will write its PID (meij)
+ - added a few more cattle-themed calamities (anonymous @ idlerpg.net forum)
+ - added a trailing '!' to godsend() text instead of the drab old '.'
+ - added some new quests/calamities/godsends contributed by users. edited some
+ old calamities/quests/godsends. please feel free to post your ideas for more
+ to http://idlerpg.net/forum.php! (anonymous, Afbc0m, anjira, jv, mrChewie,
+ W8TVI, et al)
+ - attempted to scale occurences of HOGs, godsends, calamities, and team
+ battles. HOGs should occur about 1/user/20 days, calamities 1/user/8 days,
+ godsends 1/user/4 days, team battles 1/user/4 days. does this by calculating
+ the odds of a HOG as rand(20*86400/clock) < NUMBER_ONLINE_PLAYERS, odds of
+ calamities as rand(8*86400/clock) < NUMBER_ONLINE_PLAYERS, etc. this appears
+ to work great with at least 10 clients (tested up to 300), but doesn't seem
+ to work as well below that. would appreciate input
+ - debug information is now written to a file instead of STDOUT. bot now
+ daemonizes even though it is in debug mode. added sub debug() which takes an
+ argument of text to write to the debug file (yeoj)
+ - added new item, Jeff's Cluehammer of Doom, item level 300-350, required user
+ level 52+, chance 1/40
+ - bot will try to regain primary nickname if he sees it come open through a
+ /nick or /quit
+ - DELOLD command will removed non-logged-in accounts that have not been logged
+ into in more than N days. format is:
+ /msg bot DELOLD <N days>
+ DELOLD is a p0, admin command (DinTn)
+ - added option to enable a STATUS command. this p0 command gives information
+ on a user, such as level, class, time to level, item sum, etc. useful for
+ those IRPGs that lack a website. format is:
+ /msg bot STATUS [username]
+ if username argument is not passed, returns information on the user issuing
+ command. must be logged in to use STATUS (TGS)
+ - possibly added option to choose which local address/hostname and local port
+ to bind to. let me know if this does/doesn't work (DARKutz, Brad)
+ - added security note to head of file
+ - will not send auto-login user list if text > 2048 bytes
+ - added $opts{botmodes} which will set the bot's usermode to given string on
+ connect
+ - removed reset of last login time on auto-login; last login should be when
+ user last logged in, not when the bot logged them back in
+ - levels after level 60 have a next time to level of (time to level @ 60) +
+ (1 day) * (level - 60). levels below 60 have not changed. the exponential
+ code was getting a little too heavy by itself (TGS)
+ - RELOADDB would log all players out; fixed
+ - sts() & fq() check state of socket before attempting write. if cannot write,
+ outgoing queue is cleared
+ - added new item, Mrquick's Magical Boots of Swiftness, item level 250-300,
+ required user level 48+, chance 1/40
+ - debug messages are now timestamped. added a few extra debug messages, mostly
+ for fun
+ - top player report no longer occurs immediately after startup, but every 6
+ hours from then on
+ - added option to disallow registration of usernames/character classes
+ containing ctrl codes (Skill0)
+ - changed auto-login code from list to hash. would take several minutes to
+ synch to a channel with hundreds of users. now takes < 1s (Vayanla et al)
+ - removed the hard-coded "#G7" from the top players list.. whoops :^) that's
+ been there for some time now, can't believe no one ever noticed (HaRRo)
+ - added option to voice users on login/register. if you +m your channel, this
+ will cut down on spam, but won't allow non-logged-in or devoiced/deopped
+ clients to talk (pingh, wishes, aphade, et al)
+ - added a penalize() sub to make penalties a little cleaner
+ - added %quest hash to keep up with active quest info
+ - added option to write active quest info to file; this makes it readable by
+ outside programs
+ - can now specify multiple words for the advertisement ban, or turn feature
+ off entirely
+ - removed all alarm() code, should now run on any system supporting select(2)
+ (including, but not limited to, Win32). should also fix a nasty, terrible
+ time drift bug; with the amount of processing done in rpcheck(), the next
+ alarm() would come later than expected, awarding the user with idling less
+ than he had actually idled. it's a small amount, but adds up to about 205
+ seconds difference in the clocks after ~9.25 hours (in my tests; will differ
+ from machine to machine). MANY thanks to this bug's reporter, Ville
+ Luolajan-Mikkola
+ - added CLEARQ command, will clear all items in outgoing message queue
+ - INFO shows outgoing queue status, registrations this period, and total users
+ - cleaned up options section a little bit, made a few other code clean-ups
+ - created this file, ChangeLog.txt. the bot's code was getting too long
+ - registrations are now limited to 1 / sec. this should keep floodbots from
+ registering hundreds of accounts
+ - removed ALERT command
+ - removed $opts{admin} array, there is now a field in the db to mark this.
+ there is also a MKADMIN command to set an account as having admin access.
+ syntax is:
+ /msg bot MKADMIN <username>
+ there is no way to remove an account's administrator privileges, save from
+ editing the database by hand (well, there is PEVAL). so, don't assign this
+ lightly. admins have full access to the account under which you run the bot
+ - die() call if could not write irpg.db is now a chanmsg() instead
+ - added an outgoing message queue. all messages are now output at 1 message /
+ second, unless a non-zero $skipq flag is passed to sts(). privmsg(),
+ notice(), and chanmsg() calls pass their $force flag as a $skipq flag.
+ PONGs pass a $skipq of 1 (LexCyber)
+ - fixed a rather huge bug that someone on slashnet noticed. registering
+ \001PING\001 (or any other ctcp) would send that CTCP to the channel, then
+ penalize any who responded. usernames may no longer include a \001
+ - godsends, calamities, and quests were all moved to one file,
+ $opts{eventsfile}. quests are prefixed with a Q1 or Q2, depending on their
+ type; calamities with a C; and godsends with a G. quests are also prefixed
+ by their required coordinates if the quest type is 2
+ - fixed a typo in the Dwyn's Storm text
+ - changed code indentation to four spaces. reworked a lot of code to fit <= 80
+ columns
+ - changed QUEST command and quest() output to be a little more grammar-
+ friendly
+ - item stealing! if you are level >= 20, and you win a battle against a
+ player, you have a slightly less than 2% chance of stealing an item from
+ them. the 2% comes from a) you have a 1/25 chance to attempt to steal an
+ item and b) you have a 50% chance that your item (type is random) is lower
+ than theirs. the reason it's 'slightly less than' 2% is because you cannot
+ both Critical Strike a user and steal an item, so it's (2 - (1/35))%. you
+ cannot steal an item of lower level than your current item (Afbc0m)
+ - fixed duration() to show 1 day without trailing 's'
+ - re-added report of TTL after battle and after critical strike
+ - quest() function now chanmsg()s an error if it cannot open the
+ $opts{eventsfile} file
+ - INFO command now uses privmsg() force flag
+ - added grid! thanks to Joakim @ orkut for this great idea. within the irpg
+ world are all of the players on a 500x500 "grid" or map. every second, your
+ character has an equal chance to step left, right, or neither, and an equal
+ chance to step up, down, or neither. if your character encounters another
+ player, you have a 1/(# of online players) chance to battle. also, some
+ quests require all characters to reach some point on the map. quest
+ penalties and awards have not changed
+ - added REMOVEME command for users. if you are logged in,
+ /msg bot REMOVEME
+ will delete your account. this is a p0 command :^)
+ - added NEWPASS command for users. if you are logged in,
+ /msg bot NEWPASS <new password>
+ will set a new password. this is a p0 command
+
+
+--------------------------------------------------------------------------------
+ v2.4.1: unreleased
+--------------------------------------------------------------------------------
+
+ - PEVAL will now error and refuse to send output > 15 lines. this is to avoid
+ my own errors
+
+
+--------------------------------------------------------------------------------
+ v2.4+fixes: released 2/20/04
+--------------------------------------------------------------------------------
+
+ - items are set to 0 on account creation; they were previous undefined
+ - bug with QUEST command fixed; would say no active quest even when a quest
+ was active
+
+
+--------------------------------------------------------------------------------
+ v2.4: released 10/13/03
+--------------------------------------------------------------------------------
+
+ - updated privmsg() function to avoid annoying substr()/uninitialized value
+ warnings
+ - few small bugs in battling bot fixed. a win against bot awards you with 20%
+ of your TTL removed. a loss to bot adds 10% of your TTL to your clock
+ - bot's item sum is now the highest item sum of all users + 1 (mumkin)
+ - fixed RESTART command to clear alarm() before trying to exec()
+ - WHOAMI displays class, TTL (Minhiriath)
+ - CALC command removed
+ - added notice() function which mirrors the operation of privmsg()
+ - SILENT command allows admin to switch bot between 4 modes of silence. in
+ mode 0, bot sends all privmsgs. in mode 1, only chanmsg() is disabled. in
+ mode 2, only privmsg()/notice() to non-channels is disabled. in mode 3,
+ privmsgs/notices to users and channels are disabled. silent mode is also
+ configurable as $opts{'silentmode'}, so you can setup a bot in any channel
+ without it interrupting the channel with its privmsgs (???)
+ - third parameter added to privmsg()/notice(); force flag ignores $silentmode
+ - hard-coded check for OKish URLs to bot's 'http:'-style banning now
+ configurable (sean)
+ - JUMP command no longer penalizes if required argument is left blank
+ - BACKUP admin command tells bot to copy $opts{'dbfile'} to
+ .dbbackup/$opts{'dbfile'}TIMESTAMP; added backup() function to handle this
+ - RELOADDB command allows admin to force bot to reload player database file,
+ rewriting all memory. RELOADDB can only be used while in pause mode
+ - PAUSE command allows admin to place bot into pause mode. in pause mode, bot
+ will update player stats, but will not write database. combined with
+ RELOADDB, very effective for updating all players stats through external
+ script without taking bot offline. new accounts cannot be registered
+ while in pause mode
+ - QUEST command (p0) tells the active quest, its participants, and its time
+ left to completion
+ - ban message for 'http:'-type bans now makes unban-time more clear
+ - things have been sped up a bit. random battles for users level 45+ now occur
+ every hour. random chance for HOG, Godsends, Calamities, and Team Battles
+ were increased by a factor of 5
+ - time between quests upped to 12 hours. level requirement for quests upped to
+ 40+. in addition, must have been online for at least 10 hours to be selected
+ for quests. number of persons on quest lowered to 4. quest penalty is now a
+ p15 instead of 2% of your TTL. this makes more sense, as users who were very
+ close to leveling were penalized almost nothing (inkblot et al)
+ - fixed spelling of 'caffeinated' (sean)
+ - botchan variable now shows how to join channel with key (Dan)
+
+
+--------------------------------------------------------------------------------
+ v2.3.1: released 9/20/03
+--------------------------------------------------------------------------------
+
+ - fixed bug with item finding; bad logic sometimes resulted in user not
+ finding any item (thanks mumkin!)
+
+
+--------------------------------------------------------------------------------
+ v2.3: released 8/29/03
+--------------------------------------------------------------------------------
+
+ - Jotun's Fury max level dropped back to 174
+ - added the Drdink's Cane of Blind Rage with item level 175-200
+ - all time modifiers (battles, HoG, etc) are now written to modifiers.txt
+ - function tlog() logs a string to modifiers.txt and returns the string
+ - changed WHOAMI to not use $_
+ - fixed another bug where changing your nick would prevent you from being a
+ candidate for auto-login
+ - LOGOUT command added as a p20
+ - you may now only be logged in under one character at a time. this will help
+ protect the bot from being flooded when a single user signs on under 10
+ accounts, then is penalized and warned 10 times. attempts to login under two
+ names are not penalized
+ - fixed a bug where all of your accounts were automatically logged on so long
+ as they shared the same host as you, regardless of whether they were online
+ before (on bot restart)
+ - there is a 1/20,000 chance of a calamity occuring every 5 seconds. the
+ calamity() function chooses a random user, then smites them with bad luck.
+ the penalty for a calamity is a random 5-12% of next TTL. users are only
+ chosen from the pool of online players
+ - there is a 1/10,000 chance of a godsend occuring every 5 seconds. the
+ godsend() function chooses a random user, then betters their luck. the
+ award for a godsend is a random 5-12% of next TTL. users are only chosen
+ from the pool of online players
+ - there are now 'quests' -- six level 30+ users are chosen to go on a quest
+ at a time. if all six users make it to the quest's end, all questers are
+ awarded by removing 25% of their TTL (ie, their TTL at quest's end). to
+ complete a quest, no user can be penalized until the quest's end. quests
+ last a random time between 12 and 24 hours. if the quest is not completed,
+ ALL online users are penalized 2% of their time as punishment. users are
+ only chosen from the pool of online players (original idea from Nerje; quest
+ ideas from Tristan, brt)
+ - quests are read from file 'quests.txt' every time quest() is called. this
+ allows you to add or remove quests while the bot is still running. quests
+ are not picked in order, but chosen at random from the file
+ - fixed bug in PUSH, allowing to push into negative TTL
+ - db times changed to ctime format in lieu of scalar localtime() (now
+ sortable)
+ - added db fields for total time idled; total times penalized for privmsg,
+ nick change, part, kick, LOGOUT, quest, and quit; and time account created
+ - REGISTER no longer penalizes if you are already logged in and the command
+ fails
+ - fixed 'http:' checking to only look at message text, not entire string
+ - messages passed through privmsg() are split into 450-byte chunks and then
+ passed to their target
+ - bans put into place by the 'http:' method are now removed after 1 hour to
+ prevent filling the banlist. bans are stored in @bans, which will hold at
+ most 12 bans to prevent the bot from flooding on unban. after 12, bans are
+ still set, but not stored
+ - 'license' in header slightly changed
+ - battle results now include item sums and the random number rolled for each
+ player. format is [roll/sum]
+ - bot will try to regain his nickname every 30 mins if it is in use at
+ sign-on. added vars $primnick and $opts{'botghostcmd'}. $primnick is set
+ to $opts{'botnick'} (which may change) on load, and $opts{'botghostcmd'}
+ is a nickserv ghost command string
+ - the bot's nick ($opts{'botnick'} and $primnick) cannot be registered as
+ character names
+ - bot is now a fightable player. his item sum is random 250-650. (someone;
+ mail me if this was your idea). chances of fighting him are equal to
+ fighting any other player
+ - bot now daemonizes when starting (jwbozzy)
+ - fixed duration code to use the correct secs/day (drdink/inkblot)
+ - added a penalty to Team Battle. players will now receive or lose 20% of the
+ lowest team member's TTL (drdink)
+ - changed battling to award tie to challenger, not challengee. random number
+ is also, now, an integer, not a float
+ - every 3.5 hours, a level 45+, online player will battle; this will make it
+ easier for high-level users to level
+ - added function itemsum() to return item sum for supplied username
+ - battle results written to battles.txt are now timestamped (Juliet)
+
+
+--------------------------------------------------------------------------------
+ v2.2.2 (schmolli): released 7/18/03
+--------------------------------------------------------------------------------
+
+ * The changes in this version are based almost completely on a patch sent to
+ me by Ed Schmollinger, schmolli@IRC. Many thanks to him for his help! Here
+ are his changes:
+ - SECURITY: added subroutine mksalt to generate random salt for passwds
+ - CLEANUP: added subroutines chanmsg and privmsg to send messages to
+ bot's channel and to a specified user, respectively
+ - FEATURE: added command line argument processing and removed TEST_MODE
+ (TEST_MODE is no longer necessary.) Part of this includes moving most
+ of the variables into %opts.
+ - FIX: added check for number of existing players when printing top 3
+ - CLEANUP: changed "in:" and "out:" debug message to "<-" and "->"
+ - CLEANUP: indented concatenated lines
+
+
+--------------------------------------------------------------------------------
+ v2.2.1: released 7/16/03
+--------------------------------------------------------------------------------
+
+ - fixed a bug in item finding; if unique item was better than helm, not
+ better than its class, you would get the item (emad)
+
+
+--------------------------------------------------------------------------------
+ v2.2
+--------------------------------------------------------------------------------
+
+ - added 1/20000 chance of 'team battle' every 5 seconds. team battle is 3
+ players versus 3 other players. if the first three players win, their time
+ is lowered by 20% of the lowest of the three's TTL. if they lose, no time is
+ removed from any players. there is no chance for critical strike in a team
+ battle (Asterax)
+ - max level of Jotun's Fury Colossal Sword changed to 175
+ - fixed 'kick' bug; users that were kicked were not logged out
+ - kick added as a p250
+ - bot now only bans those non-logged in users that say 'http:' that've been in
+ the channel < 90 seconds
+ - bot won't ban for #G7-type URLs
+ - bot now shows nick of user when new account is registered
+ - forgot to close filehandle in loaddb(); fixed
+ - added a db backup every 6 hours
+
+
+--------------------------------------------------------------------------------
+ v2.1.3
+--------------------------------------------------------------------------------
+
+ - fixed bug where users changing their nick would not be candidates for
+ auto-login on a bot restart
+ - changed some messages to make them more friendly to female players (LapCat)
+
+
+--------------------------------------------------------------------------------
+ v2.1.2
+--------------------------------------------------------------------------------
+
+ - HoG can now carry or displace a player 5 - 75% toward the next level
+ - fixed CTCP version bug
+ - battling was changed from all users within 7 levels of you to all online
+ users
+ - added "unique" items, or a chance starting at level 25 to roll
+ higher-than-normal items
+
+
+--------------------------------------------------------------------------------
+ v2.1.1
+--------------------------------------------------------------------------------
+
+ - DIE, JUMP, RESTART, INFO, and PEVAL now send warnings to users that don't
+ have access to tell them so. they are still penalized
+ - bot will now penalize users without the proper access that try to use an
+ admin command
+ - add commands CHCLASS, CHUSER, and PUSH to adjust class names, usernames,
+ and next time to level, respectively
+ - HoG could occur for offline users; this is no longer the case
+ - bot now responds to CTCP version requests (drdink)
+
+
+--------------------------------------------------------------------------------
+ v2.1
+--------------------------------------------------------------------------------
+
+ - bot bans non-logged-in users that say 'http:'
+ - INFO did not check ha(); fixed
+ - bot will automagically log you back in if you were logged in before a bot
+ restart, and if you haven't changed your nick!user@host since then
+ - removed logging
+ - dropped functions relating to old database in favor of the new one
+ - changed level up report from seconds to duration()
+ - changed item/userinfo db's to one file; battles still in battles.txt
+ - changed challenge report from seconds to duration()
+ - changed penalty text to display duration() instead of seconds
+ - added critical strike, 1/35 chance upon winning battle to cause opponent to
+ lose time (dwyn)
+ - changed summon text for HoG (res0)
+ - changed access to base off of irpg username in lieu of host
+ - changed top player report to every 6 hours
+ - changed positive HoG text (res0)
+ - changed random HoG chance to 1/20000 every 5 seconds
+
+
+--------------------------------------------------------------------------------
+ v2.0.3
+--------------------------------------------------------------------------------
+
+ - dropped top players back to 3
+ - removed STATUS; TTL available through website.
+ - battle history added to website; added logging of battles to battles.txt
+ - peval did not next(); fixed.
+ - added HOG command, randomly chooses someone, then randomly raises/lowers
+ their TTL (20% raise, 80% lower). HOG is, of course, an abbreviation for
+ Hand of God
+ - added a 1/7500 random HoG into rpcheck()
+
+
+--------------------------------------------------------------------------------
+ v2.0.2
+--------------------------------------------------------------------------------
+
+ - STATUS would log you out; fixed.
+ - could STATUS if not online; fixed.
+ - added DEL command to remove accounts
+ - added ALERT command to make channel alerts
+ - changed admin HELP command text to display website
+
+
+--------------------------------------------------------------------------------
+ v2.0.1
+--------------------------------------------------------------------------------
+
+ - fixed self-battle bug
+ - changed chance to battle from 20% to 25% if level < 25, 100% if >= 25
+ - setup companion website
+ - updated HELP command to reflect website
+ - changed battle gain to (max(7,opplevel/4)/100)*your_next_ttl
+ - added battle loss of (max(7,opplevel/7)/100)*your_next_ttl
+
+
+--------------------------------------------------------------------------------
+ v2.0
+--------------------------------------------------------------------------------
+
+ - added item finding and battling
+ - added penalties for QUIT, PART, instead of resetting time to the beginning
+ of that level
+
+
+--------------------------------------------------------------------------------
+ v1.0
+--------------------------------------------------------------------------------
+
+ - initial version
diff --git a/README b/README
new file mode 100644
index 0000000..b07a016
--- /dev/null
+++ b/README
@@ -0,0 +1,62 @@
+--------------------------------------------------------------------------------
+First-time users:
+--------------------------------------------------------------------------------
+
+1. Using your favorite text editor, open the bot's source. Read the file header.
+ If you don't agree with the license, please delete the source and remove
+ each of your brain cells associated with it. Kthx.
+2. Open the file .irpg.conf and edit the bot's options to suit you. You must
+ also move this file into the same directory where the bot resides.
+3. Run it with: perl bot.filename.pl
+4. If you have problems, try running it in debug mode:
+ perl bot.filename.pl --debug
+ If you cannot diagnose the problem, post to http://idlerpg.net/forum.php
+5. Thanks for your interest in Idle RPG!
+
+--------------------------------------------------------------------------------
+IRPG 3.0 users looking to upgrade:
+--------------------------------------------------------------------------------
+
+1. Using your favorite text editor, open the bot's source. Read the file header.
+ If you don't agree with the license, please delete the source and remove
+ each of your brain cells associated with it. Kthx.
+2. Open the file .irpg.conf and edit the bot's options to suit you. You must
+ also move this file into the same directory where the bot resides.
+3. Replace your old bot source with the new one, ie, rm -f that old, buggy crap.
+4. Run it with: perl bot.filename.pl
+5. If you have problems, try running it in debug mode:
+ perl bot.filename.pl --debug
+ If you cannot diagnose the problem, post to http://idlerpg.net/forum.php
+6. Thanks for your interest in Idle RPG!
+
+
+--------------------------------------------------------------------------------
+IRPG 2.4 users looking to upgrade:
+--------------------------------------------------------------------------------
+
+1. Using your favorite text editor, open the bot's source. Read the file header.
+ If you don't agree with the license, please delete the source and remove
+ each of your brain cells associated with it. Kthx.
+2. Run the db conversion tool: perl irpgdbtool
+3. Answer the questions to suit you.
+4. Open the file .irpg.conf and edit the bot's options to suit you. You must
+ also move this file into the same directory where the bot resides.
+5. Run it with: perl bot.filename.pl
+6. If you have problems, try running it in debug mode:
+ perl bot.filename.pl --debug
+ If you cannot diagnose the problem, post to http://idlerpg.net/forum.php
+7. Thanks for your interest in Idle RPG!
+
+
+--------------------------------------------------------------------------------
+Pre-2.4 users looking to upgrade:
+--------------------------------------------------------------------------------
+
+1. Using your favorite text editor, open the bot's source. Read the file header.
+ If you don't agree with the license, please delete the source and remove
+ each of your brain cells associated with it. Kthx.
+2. I don't think the irpgdbtool will help you unless you're comfortable with
+ Perl, sorry. :/ If you are, though, you can pull the loaddb() sub from the
+ bot that you're currently using instead of using the loaddb() supplied in
+ irpgdbtool. You'll also need to add code to add in the other missing fields
+ that exist in v2.4.
diff --git a/bot.v3.1.2.pl b/bot.v3.1.2.pl
new file mode 100644
index 0000000..1ba6315
--- /dev/null
+++ b/bot.v3.1.2.pl
@@ -0,0 +1,2353 @@
+#!/usr/local/bin/perl
+# irpg bot v3.1.2 by jotun, jotun@idlerpg.net, et al. See http://idlerpg.net/
+#
+# Some code within this file was written by authors other than myself. As such,
+# distributing this code or distributing modified versions of this code is
+# strictly prohibited without written authorization from the authors. Contact
+# jotun@idlerpg.net. Please note that this may change (at any time, no less) if
+# authorization for distribution is given by patch submitters.
+#
+# As a side note, patches submitted for this project are automatically taken to
+# be freely distributable and modifiable for any use, public or private, though
+# I make no claim to ownership; original copyrights will be retained.. except as
+# I've just stated.
+#
+# Please mail bugs, etc. to me. Patches are welcome to fix bugs or clean up
+# the code, but please do not use a radically different coding style. Thanks
+# to everyone that's contributed!
+#
+# NOTE: This code should NOT be run as root. You deserve anything that happens
+# to you if you run this code as a superuser. Also, note that giving a
+# user admin access to the bot effectively gives them full access to the
+# user under which your bot runs, as they can use the PEVAL command to
+# execute any command, or possibly even change your password. I sincerely
+# suggest that you exercise extreme caution when giving someone admin
+# access to your bot, or that you disable the PEVAL command for non-owner
+# accounts in your config file, .irpg.conf
+
+use strict;
+use warnings;
+use IO::Socket;
+use IO::Select;
+use Data::Dumper;
+use Getopt::Long;
+
+my %opts;
+
+readconfig();
+
+my $version = "3.1.2";
+
+# command line overrides .irpg.conf
+GetOptions(\%opts,
+ "help|h",
+ "verbose|v",
+ "debug",
+ "debugfile=s",
+ "server|s=s",
+ "botnick|n=s",
+ "botuser|u=s",
+ "botrlnm|r=s",
+ "botchan|c=s",
+ "botident|p=s",
+ "botmodes|m=s",
+ "botopcmd|o=s",
+ "localaddr=s",
+ "botghostcmd|g=s",
+ "helpurl=s",
+ "admincommurl=s",
+ "doban",
+ "silentmode=i",
+ "writequestfile",
+ "questfilename=s",
+ "voiceonlogin",
+ "noccodes",
+ "nononp",
+ "mapurl=s",
+ "statuscmd",
+ "pidfile=s",
+ "reconnect",
+ "reconnect_wait=i",
+ "self_clock=i",
+ "modsfile=s",
+ "casematters",
+ "detectsplits",
+ "splitwait=i",
+ "allowuserinfo",
+ "noscale",
+ "phonehome",
+ "owner=s",
+ "owneraddonly",
+ "ownerdelonly",
+ "ownerpevalonly",
+ "checkupdates",
+ "senduserlist",
+ "limitpen=i",
+ "mapx=i",
+ "mapy=i",
+ "modesperline=i",
+ "okurl|k=s@",
+ "eventsfile=s",
+ "rpstep=f",
+ "rpbase=i",
+ "rppenstep=f",
+ "dbfile|irpgdb|db|d=s",
+) or debug("Error: Could not parse command line. Try $0 --help\n",1);
+
+$opts{help} and do { help(); exit 0; };
+
+debug("Config: read $_: ".Dumper($opts{$_})) for keys(%opts);
+
+my $outbytes = 0; # sent bytes
+my $primnick = $opts{botnick}; # for regain or register checks
+my $inbytes = 0; # received bytes
+my %onchan; # users on game channel
+my %rps; # role-players
+my %quest = (
+ questers => [],
+ p1 => [], # point 1 for q2
+ p2 => [], # point 2 for q2
+ qtime => time() + int(rand(21600)), # first quest starts in <=6 hours
+ text => "",
+ type => 1,
+ stage => 1); # quest info
+
+my $rpreport = 0; # constant for reporting top players
+my %prev_online; # user@hosts online on restart, die
+my %auto_login; # users to automatically log back on
+my @bans; # bans auto-set by the bot, saved to be removed after 1 hour
+my $pausemode = 0; # pausemode on/off flag
+my $silentmode = 0; # silent mode 0/1/2/3, see head of file
+my @queue; # outgoing message queue
+my $lastreg = 0; # holds the time of the last reg. cleared every second.
+ # prevents more than one account being registered / second
+my $registrations = 0; # count of registrations this period
+my $sel; # IO::Select object
+my $lasttime = 1; # last time that rpcheck() was run
+my $buffer; # buffer for socket stuff
+my $conn_tries = 0; # number of connection tries. gives up after trying each
+ # server twice
+my $sock; # IO::Socket::INET object
+my %split; # holds nick!user@hosts for clients that have been netsplit
+my $freemessages = 4; # number of "free" privmsgs we can send. 0..$freemessages
+
+sub daemonize(); # prototype to avoid warnings
+
+if (! -e $opts{dbfile}) {
+ $|=1;
+ %rps = ();
+ print "$opts{dbfile} does not appear to exist. I'm guessing this is your ".
+ "first time using IRPG. Please give an account name that you would ".
+ "like to have admin access [$opts{owner}]: ";
+ chomp(my $uname = <STDIN>);
+ $uname =~ s/\s.*//g;
+ $uname = length($uname)?$uname:$opts{owner};
+ print "Enter a character class for this account: ";
+ chomp(my $uclass = <STDIN>);
+ $rps{$uname}{class} = substr($uclass,0,30);
+ print "Enter a password for this account: ";
+ if ($^O ne "MSWin32") {
+ system("stty -echo");
+ }
+ chomp(my $upass = <STDIN>);
+ if ($^O ne "MSWin32") {
+ system("stty echo");
+ }
+ $rps{$uname}{pass} = crypt($upass,mksalt());
+ $rps{$uname}{next} = $opts{rpbase};
+ $rps{$uname}{nick} = "";
+ $rps{$uname}{userhost} = "";
+ $rps{$uname}{level} = 0;
+ $rps{$uname}{online} = 0;
+ $rps{$uname}{idled} = 0;
+ $rps{$uname}{created} = time();
+ $rps{$uname}{lastlogin} = time();
+ $rps{$uname}{x} = int(rand($opts{mapx}));
+ $rps{$uname}{y} = int(rand($opts{mapy}));
+ $rps{$uname}{alignment}="n";
+ $rps{$uname}{isadmin} = 1;
+ for my $item ("ring","amulet","charm","weapon","helm",
+ "tunic","pair of gloves","shield",
+ "set of leggings","pair of boots") {
+ $rps{$uname}{item}{$item} = 0;
+ }
+ for my $pen ("pen_mesg","pen_nick","pen_part",
+ "pen_kick","pen_quit","pen_quest",
+ "pen_logout","pen_logout") {
+ $rps{$uname}{$pen} = 0;
+ }
+ writedb();
+ print "OK, wrote you into $opts{dbfile}.\n";
+}
+
+# this is almost silly...
+if ($opts{checkupdates}) {
+ print "Checking for updates...\n\n";
+ my $tempsock = IO::Socket::INET->new(PeerAddr=>"jotun.ultrazone.org:80",
+ Timeout => 15);
+ if ($tempsock) {
+ print $tempsock "GET /g7/version.php?version=$version HTTP/1.1\r\n".
+ "Host: jotun.ultrazone.org:80\r\n\r\n";
+ my($line,$newversion);
+ while ($line=<$tempsock>) {
+ chomp($line);
+ next() unless $line;
+ if ($line =~ /^Current version : (\S+)/) {
+ if ($version ne $1) {
+ print "There is an update available! Changes include:\n";
+ $newversion=1;
+ }
+ else {
+ print "You are running the latest version (v$1).\n";
+ close($tempsock);
+ last();
+ }
+ }
+ elsif ($newversion && $line =~ /^( -? .+)/) { print "$1\n"; }
+ elsif ($newversion && $line =~ /^URL: (.+)/) {
+ print "\nGet the newest version from $1!\n";
+ close($tempsock);
+ last();
+ }
+ }
+ }
+ else { print debug("Could not connect to update server.")."\n"; }
+}
+
+print "\n".debug("Becoming a daemon...")."\n";
+daemonize();
+
+$SIG{HUP} = "readconfig"; # sighup = reread config file
+
+CONNECT: # cheese.
+
+loaddb();
+
+while (!$sock && $conn_tries < 2*@{$opts{servers}}) {
+ debug("Connecting to $opts{servers}->[0]...");
+ my %sockinfo = (PeerAddr => $opts{servers}->[0],
+ PeerPort => 6667);
+ if ($opts{localaddr}) { $sockinfo{LocalAddr} = $opts{localaddr}; }
+ $sock = IO::Socket::INET->new(%sockinfo) or
+ debug("Error: failed to connect: $!\n");
+ ++$conn_tries;
+ if (!$sock) {
+ # cycle front server to back if connection failed
+ push(@{$opts{servers}},shift(@{$opts{servers}}));
+ }
+ else { debug("Connected."); }
+}
+
+if (!$sock) {
+ debug("Error: Too many connection failures, exhausted server list.\n",1);
+}
+
+$conn_tries=0;
+
+$sel = IO::Select->new($sock);
+
+sts("NICK $opts{botnick}");
+sts("USER $opts{botuser} 0 0 :$opts{botrlnm}");
+
+while (1) {
+ my($readable) = IO::Select->select($sel,undef,undef,0.5);
+ if (defined($readable)) {
+ my $fh = $readable->[0];
+ my $buffer2;
+ $fh->recv($buffer2,512,0);
+ if (length($buffer2)) {
+ $buffer .= $buffer2;
+ while (index($buffer,"\n") != -1) {
+ my $line = substr($buffer,0,index($buffer,"\n")+1);
+ $buffer = substr($buffer,length($line));
+ parse($line);
+ }
+ }
+ else {
+ # uh oh, we've been disconnected from the server, possibly before
+ # we've logged in the users in %auto_login. so, we'll set those
+ # users' online flags to 1, rewrite db, and attempt to reconnect
+ # (if that's wanted of us)
+ $rps{$_}{online}=1 for keys(%auto_login);
+ writedb();
+
+ close($fh);
+ $sel->remove($fh);
+
+ if ($opts{reconnect}) {
+ undef(@queue);
+ undef($sock);
+ debug("Socket closed; disconnected. Cleared outgoing message ".
+ "queue. Waiting $opts{reconnect_wait}s before next ".
+ "connection attempt...");
+ sleep($opts{reconnect_wait});
+ goto CONNECT;
+ }
+ else { debug("Socket closed; disconnected.",1); }
+ }
+ }
+ else { select(undef,undef,undef,1); }
+ if ((time()-$lasttime) >= $opts{self_clock}) { rpcheck(); }
+}
+
+
+sub parse {
+ my($in) = shift;
+ $inbytes += length($in); # increase parsed byte count
+ $in =~ s/[\r\n]//g; # strip all \r and \n
+ debug("<- $in");
+ my @arg = split(/\s/,$in); # split into "words"
+ my $usernick = substr((split(/!/,$arg[0]))[0],1);
+ # logged in char name of nickname, or undef if nickname is not online
+ my $username = finduser($usernick);
+ if (lc($arg[0]) eq 'ping') { sts("PONG $arg[1]",1); }
+ elsif (lc($arg[0]) eq 'error') {
+ # uh oh, we've been disconnected from the server, possibly before we've
+ # logged in the users in %auto_login. so, we'll set those users' online
+ # flags to 1, rewrite db, and attempt to reconnect (if that's wanted of
+ # us)
+ $rps{$_}{online}=1 for keys(%auto_login);
+ writedb();
+ return;
+ }
+ $arg[1] = lc($arg[1]); # original case no longer matters
+ if ($arg[1] eq '433' && $opts{botnick} eq $arg[3]) {
+ $opts{botnick} .= 0;
+ sts("NICK $opts{botnick}");
+ }
+ elsif ($arg[1] eq 'join') {
+ # %onchan holds time user joined channel. used for the advertisement ban
+ $onchan{$usernick}=time();
+ if ($opts{'detectsplits'} && exists($split{substr($arg[0],1)})) {
+ delete($split{substr($arg[0],1)});
+ }
+ elsif ($opts{botnick} eq $usernick) {
+ sts("WHO $opts{botchan}");
+ (my $opcmd = $opts{botopcmd}) =~ s/%botnick%/$opts{botnick}/eg;
+ sts($opcmd);
+ $lasttime = time(); # start rpcheck()
+ }
+ }
+ elsif ($arg[1] eq 'quit') {
+ # if we see our nick come open, grab it (skipping queue)
+ if ($usernick eq $primnick) { sts("NICK $primnick",1); }
+ elsif ($opts{'detectsplits'} &&
+ "@arg[2..$#arg]" =~ /^:\S+\.\S+ \S+\.\S+$/) {
+ if (defined($username)) { # user was online
+ $split{substr($arg[0],1)}{time}=time();
+ $split{substr($arg[0],1)}{account}=$username;
+ }
+ }
+ else {
+ penalize($username,"quit");
+ }
+ delete($onchan{$usernick});
+ }
+ elsif ($arg[1] eq 'nick') {
+ # if someone (nickserv) changes our nick for us, update $opts{botnick}
+ if ($usernick eq $opts{botnick}) {
+ $opts{botnick} = substr($arg[2],1);
+ }
+ # if we see our nick come open, grab it (skipping queue), unless it was
+ # us who just lost it
+ elsif ($usernick eq $primnick) { sts("NICK $primnick",1); }
+ else {
+ penalize($username,"nick",$arg[2]);
+ $onchan{substr($arg[2],1)} = delete($onchan{$usernick});
+ }
+ }
+ elsif ($arg[1] eq 'part') {
+ penalize($username,"part");
+ delete($onchan{$usernick});
+ }
+ elsif ($arg[1] eq 'kick') {
+ $usernick = $arg[3];
+ penalize(finduser($usernick),"kick");
+ delete($onchan{$usernick});
+ }
+ # don't penalize /notices to the bot
+ elsif ($arg[1] eq 'notice' && $arg[2] ne $opts{botnick}) {
+ penalize($username,"notice",length("@arg[3..$#arg]")-1);
+ }
+ elsif ($arg[1] eq '001') {
+ # send our identify command, set our usermode, join channel
+ sts($opts{botident});
+ sts("MODE $opts{botnick} :$opts{botmodes}");
+ sts("JOIN $opts{botchan}");
+ $opts{botchan} =~ s/ .*//; # strip channel key if present
+ }
+ elsif ($arg[1] eq '315') {
+ # 315 is /WHO end. report who we automagically signed online iff it will
+ # print < 1k of text
+ if (keys(%auto_login)) {
+ # not a true measure of size, but easy
+ if (length("%auto_login") < 1024 && $opts{senduserlist}) {
+ chanmsg(scalar(keys(%auto_login))." users matching ".
+ scalar(keys(%prev_online))." hosts automatically ".
+ "logged in; accounts: ".join(", ",keys(%auto_login)));
+ }
+ else {
+ chanmsg(scalar(keys(%auto_login))." users matching ".
+ scalar(keys(%prev_online))." hosts automatically ".
+ "logged in.");
+ }
+ if ($opts{voiceonlogin}) {
+ my @vnicks = map { $rps{$_}{nick} } keys(%auto_login);
+ while (@vnicks) {
+ sts("MODE $opts{botchan} +".
+ ('v' x $opts{modesperline})." ".
+ join(" ",@vnicks[0..$opts{modesperline}-1]));
+ splice(@vnicks,0,$opts{modesperline});
+ }
+ }
+ }
+ else { chanmsg("0 users qualified for auto login."); }
+ undef(%prev_online);
+ undef(%auto_login);
+ }
+ elsif ($arg[1] eq '005') {
+ if ("@arg" =~ /MODES=(\d+)/) { $opts{modesperline}=$1; }
+ }
+ elsif ($arg[1] eq '352') {
+ my $user;
+ # 352 is one line of /WHO. check that the nick!user@host exists as a key
+ # in %prev_online, the list generated in loaddb(). the value is the user
+ # to login
+ $onchan{$arg[7]}=time();
+ if (exists($prev_online{$arg[7]."!".$arg[4]."\@".$arg[5]})) {
+ $rps{$prev_online{$arg[7]."!".$arg[4]."\@".$arg[5]}}{online} = 1;
+ $auto_login{$prev_online{$arg[7]."!".$arg[4]."\@".$arg[5]}}=1;
+ }
+ }
+ elsif ($arg[1] eq 'privmsg') {
+ $arg[0] = substr($arg[0],1); # strip leading : from privmsgs
+ if (lc($arg[2]) eq lc($opts{botnick})) { # to us, not channel
+ $arg[3] = lc(substr($arg[3],1)); # lowercase, strip leading :
+ if ($arg[3] eq "\1version\1") {
+ notice("\1VERSION IRPG bot v$version by jotun; ".
+ "http://idlerpg.net/\1",$usernick);
+ }
+ elsif ($arg[3] eq "peval") {
+ if (!ha($username) || ($opts{ownerpevalonly} &&
+ $opts{owner} ne $username)) {
+ privmsg("You don't have access to PEVAL.", $usernick);
+ }
+ else {
+ my @peval = eval "@arg[4..$#arg]";
+ if (@peval >= 4 || length("@peval") > 1024) {
+ privmsg("Command produced too much output to send ".
+ "outright; queueing ".length("@peval").
+ " bytes in ".scalar(@peval)." items. Use ".
+ "CLEARQ to clear queue if needed.",$usernick,1);
+ privmsg($_,$usernick) for @peval;
+ }
+ else { privmsg($_,$usernick, 1) for @peval; }
+ privmsg("EVAL ERROR: $@", $usernick, 1) if $@;
+ }
+ }
+ elsif ($arg[3] eq "register") {
+ if (defined $username) {
+ privmsg("Sorry, you are already online as $username.",
+ $usernick);
+ }
+ else {
+ if ($#arg < 6 || $arg[6] eq "") {
+ privmsg("Try: REGISTER <char name> <password> <class>",
+ $usernick);
+ privmsg("IE : REGISTER Poseidon MyPassword God of the ".
+ "Sea",$usernick);
+ }
+ elsif ($pausemode) {
+ privmsg("Sorry, new accounts may not be registered ".
+ "while the bot is in pause mode; please wait ".
+ "a few minutes and try again.",$usernick);
+ }
+ elsif (exists $rps{$arg[4]} || ($opts{casematters} &&
+ scalar(grep { lc($arg[4]) eq lc($_) } keys(%rps)))) {
+ privmsg("Sorry, that character name is already in use.",
+ $usernick);
+ }
+ elsif (lc($arg[4]) eq lc($opts{botnick}) ||
+ lc($arg[4]) eq lc($primnick)) {
+ privmsg("Sorry, that character name cannot be ".
+ "registered.",$usernick);
+ }
+ elsif (!exists($onchan{$usernick})) {
+ privmsg("Sorry, you're not in $opts{botchan}.",
+ $usernick);
+ }
+ elsif (length($arg[4]) > 16 || length($arg[4]) < 1) {
+ privmsg("Sorry, character names must be < 17 and > 0 ".
+ "chars long.", $usernick);
+ }
+ elsif ($arg[4] =~ /^#/) {
+ privmsg("Sorry, character names may not begin with #.",
+ $usernick);
+ }
+ elsif ($arg[4] =~ /\001/) {
+ privmsg("Sorry, character names may not include ".
+ "character \\001.",$usernick);
+ }
+ elsif ($opts{noccodes} && ($arg[4] =~ /[[:cntrl:]]/ ||
+ "@arg[6..$#arg]" =~ /[[:cntrl:]]/)) {
+ privmsg("Sorry, neither character names nor classes ".
+ "may include control codes.",$usernick);
+ }
+ elsif ($opts{nononp} && ($arg[4] =~ /[[:^print:]]/ ||
+ "@arg[6..$#arg]" =~ /[[:^print:]]/)) {
+ privmsg("Sorry, neither character names nor classes ".
+ "may include non-printable chars.",$usernick);
+ }
+ elsif (length("@arg[6..$#arg]") > 30) {
+ privmsg("Sorry, character classes must be < 31 chars ".
+ "long.",$usernick);
+ }
+ elsif (time() == $lastreg) {
+ privmsg("Wait 1 second and try again.",$usernick);
+ }
+ else {
+ if ($opts{voiceonlogin}) {
+ sts("MODE $opts{botchan} +v :$usernick");
+ }
+ ++$registrations;
+ $lastreg = time();
+ $rps{$arg[4]}{next} = $opts{rpbase};
+ $rps{$arg[4]}{class} = "@arg[6..$#arg]";
+ $rps{$arg[4]}{level} = 0;
+ $rps{$arg[4]}{online} = 1;
+ $rps{$arg[4]}{nick} = $usernick;
+ $rps{$arg[4]}{userhost} = $arg[0];
+ $rps{$arg[4]}{created} = time();
+ $rps{$arg[4]}{lastlogin} = time();
+ $rps{$arg[4]}{pass} = crypt($arg[5],mksalt());
+ $rps{$arg[4]}{x} = int(rand($opts{mapx}));
+ $rps{$arg[4]}{y} = int(rand($opts{mapy}));
+ $rps{$arg[4]}{alignment}="n";
+ $rps{$arg[4]}{isadmin} = 0;
+ for my $item ("ring","amulet","charm","weapon","helm",
+ "tunic","pair of gloves","shield",
+ "set of leggings","pair of boots") {
+ $rps{$arg[4]}{item}{$item} = 0;
+ }
+ for my $pen ("pen_mesg","pen_nick","pen_part",
+ "pen_kick","pen_quit","pen_quest",
+ "pen_logout","pen_logout") {
+ $rps{$arg[4]}{$pen} = 0;
+ }
+ chanmsg("Welcome $usernick\'s new player $arg[4], the ".
+ "@arg[6..$#arg]! Next level in ".
+ duration($opts{rpbase}).".");
+ privmsg("Success! Account $arg[4] created. You have ".
+ "$opts{rpbase} seconds idleness until you ".
+ "reach level 1. ", $usernick);
+ privmsg("NOTE: The point of the game is to see who ".
+ "can idle the longest. As such, talking in ".
+ "the channel, parting, quitting, and changing ".
+ "nicks all penalize you.",$usernick);
+ if ($opts{phonehome}) {
+ my $tempsock = IO::Socket::INET->new(PeerAddr=>
+ "jotun.ultrazone.org:80");
+ if ($tempsock) {
+ print $tempsock
+ "GET /g7/count.php?new=1 HTTP/1.1\r\n".
+ "Host: jotun.ultrazone.org:80\r\n\r\n";
+ sleep(1);
+ close($tempsock);
+ }
+ }
+ }
+ }
+ }
+ elsif ($arg[3] eq "delold") {
+ if (!ha($username)) {
+ privmsg("You don't have access to DELOLD.", $usernick);
+ }
+ # insure it is a number
+ elsif ($arg[4] !~ /^[\d\.]+$/) {
+ privmsg("Try: DELOLD <# of days>", $usernick, 1);
+ }
+ else {
+ my @oldaccounts = grep { (time()-$rps{$_}{lastlogin}) >
+ ($arg[4] * 86400) &&
+ !$rps{$_}{online} } keys(%rps);
+ delete(@rps{@oldaccounts});
+ chanmsg(scalar(@oldaccounts)." accounts not accessed in ".
+ "the last $arg[4] days removed by $arg[0].");
+ }
+ }
+ elsif ($arg[3] eq "del") {
+ if (!ha($username)) {
+ privmsg("You don't have access to DEL.", $usernick);
+ }
+ elsif (!defined($arg[4])) {
+ privmsg("Try: DEL <char name>", $usernick, 1);
+ }
+ elsif (!exists($rps{$arg[4]})) {
+ privmsg("No such account $arg[4].", $usernick, 1);
+ }
+ else {
+ delete($rps{$arg[4]});
+ chanmsg("Account $arg[4] removed by $arg[0].");
+ }
+ }
+ elsif ($arg[3] eq "mkadmin") {
+ if (!ha($username) || ($opts{owneraddonly} &&
+ $opts{owner} ne $username)) {
+ privmsg("You don't have access to MKADMIN.", $usernick);
+ }
+ elsif (!defined($arg[4])) {
+ privmsg("Try: MKADMIN <char name>", $usernick, 1);
+ }
+ elsif (!exists($rps{$arg[4]})) {
+ privmsg("No such account $arg[4].", $usernick, 1);
+ }
+ else {
+ $rps{$arg[4]}{isadmin}=1;
+ privmsg("Account $arg[4] is now a bot admin.",$usernick, 1);
+ }
+ }
+ elsif ($arg[3] eq "deladmin") {
+ if (!ha($username) || ($opts{ownerdelonly} &&
+ $opts{owner} ne $username)) {
+ privmsg("You don't have access to DELADMIN.", $usernick);
+ }
+ elsif (!defined($arg[4])) {
+ privmsg("Try: DELADMIN <char name>", $usernick, 1);
+ }
+ elsif (!exists($rps{$arg[4]})) {
+ privmsg("No such account $arg[4].", $usernick, 1);
+ }
+ elsif ($arg[4] eq $opts{owner}) {
+ privmsg("Cannot DELADMIN owner account.", $usernick, 1);
+ }
+ else {
+ $rps{$arg[4]}{isadmin}=0;
+ privmsg("Account $arg[4] is no longer a bot admin.",
+ $usernick, 1);
+ }
+ }
+ elsif ($arg[3] eq "hog") {
+ if (!ha($username)) {
+ privmsg("You don't have access to HOG.", $usernick);
+ }
+ else {
+ chanmsg("$usernick has summoned the Hand of God.");
+ hog();
+ }
+ }
+ elsif ($arg[3] eq "rehash") {
+ if (!ha($username)) {
+ privmsg("You don't have access to REHASH.", $usernick);
+ }
+ else {
+ readconfig();
+ privmsg("Reread config file.",$usernick,1);
+ $opts{botchan} =~ s/ .*//; # strip channel key if present
+ }
+ }
+ elsif ($arg[3] eq "chpass") {
+ if (!ha($username)) {
+ privmsg("You don't have access to CHPASS.", $usernick);
+ }
+ elsif (!defined($arg[5])) {
+ privmsg("Try: CHPASS <char name> <new pass>", $usernick, 1);
+ }
+ elsif (!exists($rps{$arg[4]})) {
+ privmsg("No such username $arg[4].", $usernick, 1);
+ }
+ else {
+ $rps{$arg[4]}{pass} = crypt($arg[5],mksalt());
+ privmsg("Password for $arg[4] changed.", $usernick, 1);
+ }
+ }
+ elsif ($arg[3] eq "chuser") {
+ if (!ha($username)) {
+ privmsg("You don't have access to CHUSER.", $usernick);
+ }
+ elsif (!defined($arg[5])) {
+ privmsg("Try: CHUSER <char name> <new char name>",
+ $usernick, 1);
+ }
+ elsif (!exists($rps{$arg[4]})) {
+ privmsg("No such username $arg[4].", $usernick, 1);
+ }
+ elsif (exists($rps{$arg[5]})) {
+ privmsg("Username $arg[5] is already taken.", $usernick,1);
+ }
+ else {
+ $rps{$arg[5]} = delete($rps{$arg[4]});
+ privmsg("Username for $arg[4] changed to $arg[5].",
+ $usernick, 1);
+ }
+ }
+ elsif ($arg[3] eq "chclass") {
+ if (!ha($username)) {
+ privmsg("You don't have access to CHCLASS.", $usernick);
+ }
+ elsif (!defined($arg[5])) {
+ privmsg("Try: CHCLASS <char name> <new char class>",
+ $usernick, 1);
+ }
+ elsif (!exists($rps{$arg[4]})) {
+ privmsg("No such username $arg[4].", $usernick, 1);
+ }
+ else {
+ $rps{$arg[4]}{class} = "@arg[5..$#arg]";
+ privmsg("Class for $arg[4] changed to @arg[5..$#arg].",
+ $usernick, 1);
+ }
+ }
+ elsif ($arg[3] eq "push") {
+ if (!ha($username)) {
+ privmsg("You don't have access to PUSH.", $usernick);
+ }
+ # insure it's a positive or negative, integral number of seconds
+ elsif ($arg[5] !~ /^\-?\d+$/) {
+ privmsg("Try: PUSH <char name> <seconds>", $usernick, 1);
+ }
+ elsif (!exists($rps{$arg[4]})) {
+ privmsg("No such username $arg[4].", $usernick, 1);
+ }
+ elsif ($arg[5] > $rps{$arg[4]}{next}) {
+ privmsg("Time to level for $arg[4] ($rps{$arg[4]}{next}s) ".
+ "is lower than $arg[5]; setting TTL to 0.",
+ $usernick, 1);
+ chanmsg("$usernick has pushed $arg[4] $rps{$arg[4]}{next} ".
+ "seconds toward level ".($rps{$arg[4]}{level}+1));
+ $rps{$arg[4]}{next}=0;
+ }
+ else {
+ $rps{$arg[4]}{next} -= $arg[5];
+ chanmsg("$usernick has pushed $arg[4] $arg[5] seconds ".
+ "toward level ".($rps{$arg[4]}{level}+1).". ".
+ "$arg[4] reaches next level in ".
+ duration($rps{$arg[4]}{next}).".");
+ }
+ }
+ elsif ($arg[3] eq "logout") {
+ if (defined($username)) {
+ penalize($username,"logout");
+ }
+ else {
+ privmsg("You are not logged in.", $usernick);
+ }
+ }
+ elsif ($arg[3] eq "quest") {
+ if (!@{$quest{questers}}) {
+ privmsg("There is no active quest.",$usernick);
+ }
+ elsif ($quest{type} == 1) {
+ privmsg(join(", ",(@{$quest{questers}})[0..2]).", and ".
+ "$quest{questers}->[3] are on a quest to ".
+ "$quest{text}. Quest to complete in ".
+ duration($quest{qtime}-time()).".",$usernick);
+ }
+ elsif ($quest{type} == 2) {
+ privmsg(join(", ",(@{$quest{questers}})[0..2]).", and ".
+ "$quest{questers}->[3] are on a quest to ".
+ "$quest{text}. Participants must first reach ".
+ "[$quest{p1}->[0],$quest{p1}->[1]], then ".
+ "[$quest{p2}->[0],$quest{p2}->[1]].".
+ ($opts{mapurl}?" See $opts{mapurl} to monitor ".
+ "their journey's progress.":""),$usernick);
+ }
+ }
+ elsif ($arg[3] eq "status" && $opts{statuscmd}) {
+ if (!defined($username)) {
+ privmsg("You are not logged in.", $usernick);
+ }
+ # argument is optional
+ elsif ($arg[4] && !exists($rps{$arg[4]})) {
+ privmsg("No such user.",$usernick);
+ }
+ elsif ($arg[4]) { # optional 'user' argument
+ privmsg("$arg[4]: Level $rps{$arg[4]}{level} ".
+ "$rps{$arg[4]}{class}; Status: O".
+ ($rps{$arg[4]}{online}?"n":"ff")."line; ".
+ "TTL: ".duration($rps{$arg[4]}{next})."; ".
+ "Idled: ".duration($rps{$arg[4]}{idled}).
+ "; Item sum: ".itemsum($arg[4]),$usernick);
+ }
+ else { # no argument, look up this user
+ privmsg("$username: Level $rps{$username}{level} ".
+ "$rps{$username}{class}; Status: O".
+ ($rps{$username}{online}?"n":"ff")."line; ".
+ "TTL: ".duration($rps{$username}{next})."; ".
+ "Idled: ".duration($rps{$username}{idled})."; ".
+ "Item sum: ".itemsum($username),$usernick);
+ }
+ }
+ elsif ($arg[3] eq "whoami") {
+ if (!defined($username)) {
+ privmsg("You are not logged in.", $usernick);
+ }
+ else {
+ privmsg("You are $username, the level ".
+ $rps{$username}{level}." $rps{$username}{class}. ".
+ "Next level in ".duration($rps{$username}{next}),
+ $usernick);
+ }
+ }
+ elsif ($arg[3] eq "newpass") {
+ if (!defined($username)) {
+ privmsg("You are not logged in.", $usernick)
+ }
+ elsif (!defined($arg[4])) {
+ privmsg("Try: NEWPASS <new password>", $usernick);
+ }
+ else {
+ $rps{$username}{pass} = crypt($arg[4],mksalt());
+ privmsg("Your password was changed.",$usernick);
+ }
+ }
+ elsif ($arg[3] eq "align") {
+ if (!defined($username)) {
+ privmsg("You are not logged in.", $usernick)
+ }
+ elsif (!defined($arg[4]) || (lc($arg[4]) ne "good" &&
+ lc($arg[4]) ne "neutral" && lc($arg[4]) ne "evil")) {
+ privmsg("Try: ALIGN <good|neutral|evil>", $usernick);
+ }
+ else {
+ $rps{$username}{alignment} = substr(lc($arg[4]),0,1);
+ chanmsg("$username has changed alignment to: ".lc($arg[4]).
+ ".");
+ privmsg("Your alignment was changed to ".lc($arg[4]).".",
+ $usernick);
+ }
+ }
+ elsif ($arg[3] eq "removeme") {
+ if (!defined($username)) {
+ privmsg("You are not logged in.", $usernick)
+ }
+ else {
+ privmsg("Account $username removed.",$usernick);
+ chanmsg("$arg[0] removed his account, $username, the ".
+ $rps{$username}{class}.".");
+ delete($rps{$username});
+ }
+ }
+ elsif ($arg[3] eq "help") {
+ if (!ha($username)) {
+ privmsg("For information on IRPG bot commands, see ".
+ $opts{helpurl}, $usernick);
+ }
+ else {
+ privmsg("Help URL is $opts{helpurl}", $usernick, 1);
+ privmsg("Admin commands URL is $opts{admincommurl}",
+ $usernick, 1);
+ }
+ }
+ elsif ($arg[3] eq "die") {
+ if (!ha($username)) {
+ privmsg("You do not have access to DIE.", $usernick);
+ }
+ else {
+ $opts{reconnect} = 0;
+ writedb();
+ sts("QUIT :DIE from $arg[0]",1);
+ }
+ }
+ elsif ($arg[3] eq "reloaddb") {
+ if (!ha($username)) {
+ privmsg("You do not have access to RELOADDB.", $usernick);
+ }
+ elsif (!$pausemode) {
+ privmsg("ERROR: Can only use LOADDB while in PAUSE mode.",
+ $usernick, 1);
+ }
+ else {
+ loaddb();
+ privmsg("Reread player database file; ".scalar(keys(%rps)).
+ " accounts loaded.",$usernick,1);
+ }
+ }
+ elsif ($arg[3] eq "backup") {
+ if (!ha($username)) {
+ privmsg("You do not have access to BACKUP.", $usernick);
+ }
+ else {
+ backup();
+ privmsg("$opts{dbfile} copied to ".
+ ".dbbackup/$opts{dbfile}".time(),$usernick,1);
+ }
+ }
+ elsif ($arg[3] eq "pause") {
+ if (!ha($username)) {
+ privmsg("You do not have access to PAUSE.", $usernick);
+ }
+ else {
+ $pausemode = $pausemode ? 0 : 1;
+ privmsg("PAUSE_MODE set to $pausemode.",$usernick,1);
+ }
+ }
+ elsif ($arg[3] eq "silent") {
+ if (!ha($username)) {
+ privmsg("You do not have access to SILENT.", $usernick);
+ }
+ elsif (!defined($arg[4]) || $arg[4] < 0 || $arg[4] > 3) {
+ privmsg("Try: SILENT <mode>", $usernick,1);
+ }
+ else {
+ $silentmode = $arg[4];
+ privmsg("SILENT_MODE set to $silentmode.",$usernick,1);
+ }
+ }
+ elsif ($arg[3] eq "jump") {
+ if (!ha($username)) {
+ privmsg("You do not have access to JUMP.", $usernick);
+ }
+ elsif (!defined($arg[4])) {
+ privmsg("Try: JUMP <server[:port]>", $usernick, 1);
+ }
+ else {
+ writedb();
+ sts("QUIT :JUMP to $arg[4] from $arg[0]");
+ unshift(@{$opts{servers}},$arg[4]);
+ close($sock);
+ sleep(3);
+ goto CONNECT;
+ }
+ }
+ elsif ($arg[3] eq "restart") {
+ if (!ha($username)) {
+ privmsg("You do not have access to RESTART.", $usernick);
+ }
+ else {
+ writedb();
+ sts("QUIT :RESTART from $arg[0]",1);
+ close($sock);
+ exec("perl $0");
+ }
+ }
+ elsif ($arg[3] eq "clearq") {
+ if (!ha($username)) {
+ privmsg("You do not have access to CLEARQ.", $usernick);
+ }
+ else {
+ undef(@queue);
+ chanmsg("Outgoing message queue cleared by $arg[0].");
+ privmsg("Outgoing message queue cleared.",$usernick,1);
+ }
+ }
+ elsif ($arg[3] eq "info") {
+ my $info;
+ if (!ha($username) && $opts{allowuserinfo}) {
+ $info = "IRPG bot v$version by jotun, ".
+ "http://idlerpg.net/. On via server: ".
+ $opts{servers}->[0].". Admins online: ".
+ join(", ", map { $rps{$_}{nick} }
+ grep { $rps{$_}{isadmin} &&
+ $rps{$_}{online} } keys(%rps)).".";
+ privmsg($info, $usernick);
+ }
+ elsif (!ha($username) && !$opts{allowuserinfo}) {
+ privmsg("You do not have access to INFO.", $usernick);
+ }
+ else {
+ my $queuedbytes = 0;
+ $queuedbytes += (length($_)+2) for @queue; # +2 = \r\n
+ $info = sprintf(
+ "%.2fkb sent, %.2fkb received in %s. %d IRPG users ".
+ "online of %d total users. %d accounts created since ".
+ "startup. PAUSE_MODE is %d, SILENT_MODE is %d. ".
+ "Outgoing queue is %d bytes in %d items. On via: %s. ".
+ "Admins online: %s.",
+ $outbytes/1024,
+ $inbytes/1024,
+ duration(time()-$^T),
+ scalar(grep { $rps{$_}{online} } keys(%rps)),
+ scalar(keys(%rps)),
+ $registrations,
+ $pausemode,
+ $silentmode,
+ $queuedbytes,
+ scalar(@queue),
+ $opts{servers}->[0],
+ join(", ",map { $rps{$_}{nick} }
+ grep { $rps{$_}{isadmin} && $rps{$_}{online} }
+ keys(%rps)));
+ privmsg($info, $usernick, 1);
+ }
+ }
+ elsif ($arg[3] eq "login") {
+ if (defined($username)) {
+ notice("Sorry, you are already online as $username.",
+ $usernick);
+ }
+ else {
+ if ($#arg < 5 || $arg[5] eq "") {
+ notice("Try: LOGIN <username> <password>", $usernick);
+ }
+ elsif (!exists $rps{$arg[4]}) {
+ notice("Sorry, no such account name. Note that ".
+ "account names are case sensitive.",$usernick);
+ }
+ elsif (!exists $onchan{$usernick}) {
+ notice("Sorry, you're not in $opts{botchan}.",
+ $usernick);
+ }
+ elsif ($rps{$arg[4]}{pass} ne
+ crypt($arg[5],$rps{$arg[4]}{pass})) {
+ notice("Wrong password.", $usernick);
+ }
+ else {
+ if ($opts{voiceonlogin}) {
+ sts("MODE $opts{botchan} +v :$usernick");
+ }
+ $rps{$arg[4]}{online} = 1;
+ $rps{$arg[4]}{nick} = $usernick;
+ $rps{$arg[4]}{userhost} = $arg[0];
+ $rps{$arg[4]}{lastlogin} = time();
+ chanmsg("$arg[4], the level $rps{$arg[4]}{level} ".
+ "$rps{$arg[4]}{class}, is now online from ".
+ "nickname $usernick. Next level in ".
+ duration($rps{$arg[4]}{next}).".");
+ notice("Logon successful. Next level in ".
+ duration($rps{$arg[4]}{next}).".", $usernick);
+ }
+ }
+ }
+ }
+ # penalize returns true if user was online and successfully penalized.
+ # if the user is not logged in, then penalize() fails. so, if user is
+ # offline, and they say something including "http:", and they've been on
+ # the channel less than 90 seconds, and the http:-style ban is on, then
+ # check to see if their url is in @{$opts{okurl}}. if not, kickban them
+ elsif (!penalize($username,"privmsg",length("@arg[3..$#arg]")) &&
+ index(lc("@arg[3..$#arg]"),"http:") != -1 &&
+ (time()-$onchan{$usernick}) < 90 && $opts{doban}) {
+ my $isokurl = 0;
+ for (@{$opts{okurl}}) {
+ if (index(lc("@arg[3..$#arg]"),lc($_)) != -1) { $isokurl = 1; }
+ }
+ if (!$isokurl) {
+ sts("MODE $opts{botchan} +b $arg[0]");
+ sts("KICK $opts{botchan} $usernick :No advertising; ban will ".
+ "be lifted within the hour.");
+ push(@bans,$arg[0]) if @bans < 12;
+ }
+ }
+ }
+}
+
+sub sts { # send to server
+ my($text,$skipq) = @_;
+ if ($skipq) {
+ if ($sock) {
+ print $sock "$text\r\n";
+ $outbytes += length($text) + 2;
+ debug("-> $text");
+ }
+ else {
+ # something is wrong. the socket is closed. clear the queue
+ undef(@queue);
+ debug("\$sock isn't writeable in sts(), cleared outgoing queue.\n");
+ return;
+ }
+ }
+ else {
+ push(@queue,$text);
+ debug(sprintf("(q%03d) = %s\n",$#queue,$text));
+ }
+}
+
+sub fq { # deliver message(s) from queue
+ if (!@queue) {
+ ++$freemessages if $freemessages < 4;
+ return undef;
+ }
+ my $sentbytes = 0;
+ for (0..$freemessages) {
+ last() if !@queue; # no messages left to send
+ # lower number of "free" messages we have left
+ my $line=shift(@queue);
+ # if we have already sent one message, and the next message to be sent
+ # plus the previous messages we have sent this call to fq() > 768 bytes,
+ # then requeue this message and return. we don't want to flood off,
+ # after all
+ if ($_ != 0 && (length($line)+$sentbytes) > 768) {
+ unshift(@queue,$line);
+ last();
+ }
+ if ($sock) {
+ debug("(fm$freemessages) -> $line");
+ --$freemessages if $freemessages > 0;
+ print $sock "$line\r\n";
+ $sentbytes += length($line) + 2;
+ }
+ else {
+ undef(@queue);
+ debug("Disconnected: cleared outgoing message queue.");
+ last();
+ }
+ $outbytes += length($line) + 2;
+ }
+}
+
+sub duration { # return human duration of seconds
+ my $s = shift;
+ return "NA ($s)" if $s !~ /^\d+$/;
+ return sprintf("%d day%s, %02d:%02d:%02d",$s/86400,int($s/86400)==1?"":"s",
+ ($s%86400)/3600,($s%3600)/60,($s%60));
+}
+
+sub ts { # timestamp
+ my @ts = localtime(time());
+ return sprintf("[%02d/%02d/%02d %02d:%02d:%02d] ",
+ $ts[4]+1,$ts[3],$ts[5]%100,$ts[2],$ts[1],$ts[0]);
+}
+
+sub hog { # summon the hand of god
+ my @players = grep { $rps{$_}{online} } keys(%rps);
+ my $player = $players[rand(@players)];
+ my $win = int(rand(5));
+ my $time = int(((5 + int(rand(71)))/100) * $rps{$player}{next});
+ if ($win) {
+ chanmsg(clog("Verily I say unto thee, the Heavens have burst forth, ".
+ "and the blessed hand of God carried $player ".
+ duration($time)." toward level ".($rps{$player}{level}+1).
+ "."));
+ $rps{$player}{next} -= $time;
+ }
+ else {
+ chanmsg(clog("Thereupon He stretched out His little finger among them ".
+ "and consumed $player with fire, slowing the heathen ".
+ duration($time)." from level ".($rps{$player}{level}+1).
+ "."));
+ $rps{$player}{next} += $time;
+ }
+ chanmsg("$player reaches next level in ".duration($rps{$player}{next}).".");
+}
+
+sub rpcheck { # check levels, update database
+ # check splits hash to see if any split users have expired
+ checksplits() if $opts{detectsplits};
+ # send out $freemessages lines of text from the outgoing message queue
+ fq();
+ # clear registration limiting
+ $lastreg = 0;
+ my $online = scalar(grep { $rps{$_}{online} } keys(%rps));
+ # there's really nothing to do here if there are no online users
+ return unless $online;
+ my $onlineevil = scalar(grep { $rps{$_}{online} &&
+ $rps{$_}{alignment} eq "e" } keys(%rps));
+ my $onlinegood = scalar(grep { $rps{$_}{online} &&
+ $rps{$_}{alignment} eq "g" } keys(%rps));
+ if (!$opts{noscale}) {
+ if (rand((20*86400)/$opts{self_clock}) < $online) { hog(); }
+ if (rand((24*86400)/$opts{self_clock}) < $online) { team_battle(); }
+ if (rand((8*86400)/$opts{self_clock}) < $online) { calamity(); }
+ if (rand((4*86400)/$opts{self_clock}) < $online) { godsend(); }
+ }
+ else {
+ hog() if rand(4000) < 1;
+ team_battle() if rand(4000) < 1;
+ calamity() if rand(4000) < 1;
+ godsend() if rand(2000) < 1;
+ }
+ if (rand((8*86400)/$opts{self_clock}) < $onlineevil) { evilness(); }
+ if (rand((12*86400)/$opts{self_clock}) < $onlinegood) { goodness(); }
+
+ moveplayers();
+
+ # statements using $rpreport do not bother with scaling by the clock because
+ # $rpreport is adjusted by the number of seconds since last rpcheck()
+ if ($rpreport%120==0 && $opts{writequestfile}) { writequestfile(); }
+ if (time() > $quest{qtime}) {
+ if (!@{$quest{questers}}) { quest(); }
+ elsif ($quest{type} == 1) {
+ chanmsg(clog(join(", ",(@{$quest{questers}})[0..2]).", and ".
+ "$quest{questers}->[3] have blessed the realm by ".
+ "completing their quest! 25% of their burden is ".
+ "eliminated."));
+ for (@{$quest{questers}}) {
+ $rps{$_}{next} = int($rps{$_}{next} * .75);
+ }
+ undef(@{$quest{questers}});
+ $quest{qtime} = time() + 21600;
+ }
+ # quest type 2 awards are handled in moveplayers()
+ }
+ if ($rpreport && $rpreport%36000==0) { # 10 hours
+ my @u = sort { $rps{$b}{level} <=> $rps{$a}{level} ||
+ $rps{$a}{next} <=> $rps{$b}{next} } keys(%rps);
+ chanmsg("Idle RPG Top Players:") if @u;
+ for my $i (0..2) {
+ $#u >= $i and
+ chanmsg("$u[$i], the level $rps{$u[$i]}{level} ".
+ "$rps{$u[$i]}{class}, is #" . ($i + 1) . "! Next level in ".
+ (duration($rps{$u[$i]}{next})).".");
+ }
+ backup();
+ }
+ if ($rpreport%3600==0 && $rpreport) { # 1 hour
+ my @players = grep { $rps{$_}{online} &&
+ $rps{$_}{level} > 44 } keys(%rps);
+ # 20% of all players must be level 45+
+ if ((scalar(@players)/scalar(grep { $rps{$_}{online} } keys(%rps))) > .15) {
+ challenge_opp($players[int(rand(@players))]);
+ }
+ while (@bans) {
+ sts("MODE $opts{botchan} -bbbb :@bans[0..3]");
+ splice(@bans,0,4);
+ }
+ }
+ if ($rpreport%1800==0) { # 30 mins
+ if ($opts{botnick} ne $primnick) {
+ sts($opts{botghostcmd}) if $opts{botghostcmd};
+ sts("NICK $primnick");
+ }
+ }
+ if ($rpreport%600==0 && $pausemode) { # warn every 10m
+ chanmsg("WARNING: Cannot write database in PAUSE mode!");
+ }
+ # do not write in pause mode, and do not write if not yet connected. (would
+ # log everyone out if the bot failed to connect. $lasttime = time() on
+ # successful join to $opts{botchan}, initial value is 1). if fails to open
+ # $opts{dbfile}, will not update $lasttime and so should have correct values
+ # on next rpcheck().
+ if ($lasttime != 1) {
+ my $curtime=time();
+ for my $k (keys(%rps)) {
+ if ($rps{$k}{online} && exists $rps{$k}{nick} &&
+ $rps{$k}{nick} && exists $onchan{$rps{$k}{nick}}) {
+ $rps{$k}{next} -= ($curtime - $lasttime);
+ $rps{$k}{idled} += ($curtime - $lasttime);
+ if ($rps{$k}{next} < 1) {
+ $rps{$k}{level}++;
+ if ($rps{$k}{level} > 60) {
+ $rps{$k}{next} = int(($opts{rpbase} *
+ ($opts{rpstep}**60)) +
+ (86400*($rps{$k}{level} - 60)));
+ }
+ else {
+ $rps{$k}{next} = int($opts{rpbase} *
+ ($opts{rpstep}**$rps{$k}{level}));
+ }
+ chanmsg("$k, the $rps{$k}{class}, has attained level ".
+ "$rps{$k}{level}! Next level in ".
+ duration($rps{$k}{next}).".");
+ find_item($k);
+ challenge_opp($k);
+ }
+ }
+ # attempt to make sure this is an actual user, and not just an
+ # artifact of a bad PEVAL
+ }
+ if (!$pausemode && $rpreport%60==0) { writedb(); }
+ $rpreport += $opts{self_clock};
+ $lasttime = $curtime;
+ }
+}
+
+sub challenge_opp { # pit argument player against random player
+ my $u = shift;
+ if ($rps{$u}{level} < 25) { return unless rand(4) < 1; }
+ my @opps = grep { $rps{$_}{online} && $u ne $_ } keys(%rps);
+ return unless @opps;
+ my $opp = $opps[int(rand(@opps))];
+ $opp = $primnick if rand(@opps+1) < 1;
+ my $mysum = itemsum($u,1);
+ my $oppsum = itemsum($opp,1);
+ my $myroll = int(rand($mysum));
+ my $opproll = int(rand($oppsum));
+ if ($myroll >= $opproll) {
+ my $gain = ($opp eq $primnick)?20:int($rps{$opp}{level}/4);
+ $gain = 7 if $gain < 7;
+ $gain = int(($gain/100)*$rps{$u}{next});
+ chanmsg(clog("$u [$myroll/$mysum] has challenged $opp [$opproll/".
+ "$oppsum] in combat and won! ".duration($gain)." is ".
+ "removed from $u\'s clock."));
+ $rps{$u}{next} -= $gain;
+ chanmsg("$u reaches next level in ".duration($rps{$u}{next}).".");
+ my $csfactor = $rps{$u}{alignment} eq "g" ? 50 :
+ $rps{$u}{alignment} eq "e" ? 20 :
+ 35;
+ if (rand($csfactor) < 1 && $opp ne $primnick) {
+ $gain = int(((5 + int(rand(20)))/100) * $rps{$opp}{next});
+ chanmsg(clog("$u has dealt $opp a Critical Strike! ".
+ duration($gain)." is added to $opp\'s clock."));
+ $rps{$opp}{next} += $gain;
+ chanmsg("$opp reaches next level in ".duration($rps{$opp}{next}).
+ ".");
+ }
+ elsif (rand(25) < 1 && $opp ne $primnick && $rps{$u}{level} > 19) {
+ my @items = ("ring","amulet","charm","weapon","helm","tunic",
+ "pair of gloves","set of leggings","shield",
+ "pair of boots");
+ my $type = $items[rand(@items)];
+ if (int($rps{$opp}{item}{$type}) > int($rps{$u}{item}{$type})) {
+ chanmsg(clog("In the fierce battle, $opp dropped his level ".
+ int($rps{$opp}{item}{$type})." $type! $u picks ".
+ "it up, tossing his old level ".
+ int($rps{$u}{item}{$type})." $type to $opp."));
+ my $tempitem = $rps{$u}{item}{$type};
+ $rps{$u}{item}{$type}=$rps{$opp}{item}{$type};
+ $rps{$opp}{item}{$type} = $tempitem;
+ }
+ }
+ }
+ else {
+ my $gain = ($opp eq $primnick)?10:int($rps{$opp}{level}/7);
+ $gain = 7 if $gain < 7;
+ $gain = int(($gain/100)*$rps{$u}{next});
+ chanmsg(clog("$u [$myroll/$mysum] has challenged $opp [$opproll/".
+ "$oppsum] in combat and lost! ".duration($gain)." is ".
+ "added to $u\'s clock."));
+ $rps{$u}{next} += $gain;
+ chanmsg("$u reaches next level in ".duration($rps{$u}{next}).".");
+ }
+}
+
+sub team_battle { # pit three players against three other players
+ my @opp = grep { $rps{$_}{online} } keys(%rps);
+ return if @opp < 6;
+ splice(@opp,int(rand(@opp)),1) while @opp > 6;
+ fisher_yates_shuffle(\@opp);
+ my $mysum = itemsum($opp[0],1) + itemsum($opp[1],1) + itemsum($opp[2],1);
+ my $oppsum = itemsum($opp[3],1) + itemsum($opp[4],1) + itemsum($opp[5],1);
+ my $gain = $rps{$opp[0]}{next};
+ for my $p (1,2) {
+ $gain = $rps{$opp[$p]}{next} if $gain > $rps{$opp[$p]}{next};
+ }
+ $gain = int($gain*.20);
+ my $myroll = int(rand($mysum));
+ my $opproll = int(rand($oppsum));
+ if ($myroll >= $opproll) {
+ chanmsg(clog("$opp[0], $opp[1], and $opp[2] [$myroll/$mysum] have ".
+ "team battled $opp[3], $opp[4], and $opp[5] [$opproll/".
+ "$oppsum] and won! ".duration($gain)." is removed from ".
+ "their clocks."));
+ $rps{$opp[0]}{next} -= $gain;
+ $rps{$opp[1]}{next} -= $gain;
+ $rps{$opp[2]}{next} -= $gain;
+ }
+ else {
+ chanmsg(clog("$opp[0], $opp[1], and $opp[2] [$myroll/$mysum] have ".
+ "team battled $opp[3], $opp[4], and $opp[5] [$opproll/".
+ "$oppsum] and lost! ".duration($gain)." is added to ".
+ "their clocks."));
+ $rps{$opp[0]}{next} += $gain;
+ $rps{$opp[1]}{next} += $gain;
+ $rps{$opp[2]}{next} += $gain;
+ }
+}
+
+sub find_item { # find item for argument player
+ my $u = shift;
+ my @items = ("ring","amulet","charm","weapon","helm","tunic",
+ "pair of gloves","set of leggings","shield","pair of boots");
+ my $type = $items[rand(@items)];
+ my $level = 1;
+ my $ulevel;
+ for my $num (1 .. int($rps{$u}{level}*1.5)) {
+ if (rand(1.4**($num/4)) < 1) {
+ $level = $num;
+ }
+ }
+ if ($rps{$u}{level} >= 25 && rand(40) < 1) {
+ $ulevel = 50+int(rand(25));
+ if ($ulevel >= $level && $ulevel > int($rps{$u}{item}{helm})) {
+ notice("The light of the gods shines down upon you! You have ".
+ "found the level $ulevel Mattt's Omniscience Grand Crown! ".
+ "Your enemies fall before you as you anticipate their ".
+ "every move.",$rps{$u}{nick});
+ $rps{$u}{item}{helm} = $ulevel."a";
+ return;
+ }
+ }
+ elsif ($rps{$u}{level} >= 25 && rand(40) < 1) {
+ $ulevel = 50+int(rand(25));
+ if ($ulevel >= $level && $ulevel > int($rps{$u}{item}{ring})) {
+ notice("The light of the gods shines down upon you! You have ".
+ "found the level $ulevel Juliet's Glorious Ring of ".
+ "Sparkliness! You enemies are blinded by both its glory ".
+ "and their greed as you bring desolation upon them.",
+ $rps{$u}{nick});
+ $rps{$u}{item}{ring} = $ulevel."h";
+ return;
+ }
+ }
+ elsif ($rps{$u}{level} >= 30 && rand(40) < 1) {
+ $ulevel = 75+int(rand(25));
+ if ($ulevel >= $level && $ulevel > int($rps{$u}{item}{tunic})) {
+ notice("The light of the gods shines down upon you! You have ".
+ "found the level $ulevel Res0's Protectorate Plate Mail! ".
+ "Your enemies cower in fear as their attacks have no ".
+ "effect on you.",$rps{$u}{nick});
+ $rps{$u}{item}{tunic} = $ulevel."b";
+ return;
+ }
+ }
+ elsif ($rps{$u}{level} >= 35 && rand(40) < 1) {
+ $ulevel = 100+int(rand(25));
+ if ($ulevel >= $level && $ulevel > int($rps{$u}{item}{amulet})) {
+ notice("The light of the gods shines down upon you! You have ".
+ "found the level $ulevel Dwyn's Storm Magic Amulet! Your ".
+ "enemies are swept away by an elemental fury before the ".
+ "war has even begun",$rps{$u}{nick});
+ $rps{$u}{item}{amulet} = $ulevel."c";
+ return;
+ }
+ }
+ elsif ($rps{$u}{level} >= 40 && rand(40) < 1) {
+ $ulevel = 150+int(rand(25));
+ if ($ulevel >= $level && $ulevel > int($rps{$u}{item}{weapon})) {
+ notice("The light of the gods shines down upon you! You have ".
+ "found the level $ulevel Jotun's Fury Colossal Sword! Your ".
+ "enemies' hatred is brought to a quick end as you arc your ".
+ "wrist, dealing the crushing blow.",$rps{$u}{nick});
+ $rps{$u}{item}{weapon} = $ulevel."d";
+ return;
+ }
+ }
+ elsif ($rps{$u}{level} >= 45 && rand(40) < 1) {
+ $ulevel = 175+int(rand(26));
+ if ($ulevel >= $level && $ulevel > int($rps{$u}{item}{weapon})) {
+ notice("The light of the gods shines down upon you! You have ".
+ "found the level $ulevel Drdink's Cane of Blind Rage! Your ".
+ "enemies are tossed aside as you blindly swing your arm ".
+ "around hitting stuff.",$rps{$u}{nick});
+ $rps{$u}{item}{weapon} = $ulevel."e";
+ return;
+ }
+ }
+ elsif ($rps{$u}{level} >= 48 && rand(40) < 1) {
+ $ulevel = 250+int(rand(51));
+ if ($ulevel >= $level && $ulevel >
+ int($rps{$u}{item}{"pair of boots"})) {
+ notice("The light of the gods shines down upon you! You have ".
+ "found the level $ulevel Mrquick's Magical Boots of ".
+ "Swiftness! Your enemies are left choking on your dust as ".
+ "you run from them very, very quickly.",$rps{$u}{nick});
+ $rps{$u}{item}{"pair of boots"} = $ulevel."f";
+ return;
+ }
+ }
+ elsif ($rps{$u}{level} >= 52 && rand(40) < 1) {
+ $ulevel = 300+int(rand(51));
+ if ($ulevel >= $level && $ulevel > int($rps{$u}{item}{weapon})) {
+ notice("The light of the gods shines down upon you! You have ".
+ "found the level $ulevel Jeff's Cluehammer of Doom! Your ".
+ "enemies are left with a sudden and intense clarity of ".
+ "mind... even as you relieve them of it.",$rps{$u}{nick});
+ $rps{$u}{item}{weapon} = $ulevel."g";
+ return;
+ }
+ }
+ if ($level > int($rps{$u}{item}{$type})) {
+ notice("You found a level $level $type! Your current $type is only ".
+ "level ".int($rps{$u}{item}{$type}).", so it seems Luck is ".
+ "with you!",$rps{$u}{nick});
+ $rps{$u}{item}{$type} = $level;
+ }
+ else {
+ notice("You found a level $level $type. Your current $type is level ".
+ int($rps{$u}{item}{$type}).", so it seems Luck is against you. ".
+ "You toss the $type.",$rps{$u}{nick});
+ }
+}
+
+sub loaddb { # load the players database
+ backup();
+ my $l;
+ %rps = ();
+ if (!open(RPS,$opts{dbfile}) && -e $opts{dbfile}) {
+ sts("QUIT :loaddb() failed: $!");
+ }
+ while ($l=<RPS>) {
+ chomp($l);
+ next if $l =~ /^#/; # skip comments
+ next if $l =~ /^\s*$/; # skip empty lines
+ my @i = split("\t",$l);
+ print Dumper(@i) if @i != 32;
+ if (@i != 32) {
+ sts("QUIT: Anomaly in loaddb(); line $. of $opts{dbfile} has ".
+ "wrong fields (".scalar(@i).")");
+ debug("Anomaly in loaddb(); line $. of $opts{dbfile} has wrong ".
+ "fields (".scalar(@i).")",1);
+ }
+ if (!$sock) { # if not RELOADDB
+ if ($i[8]) { $prev_online{$i[7]}=$i[0]; } # log back in
+ }
+ ($rps{$i[0]}{pass},
+ $rps{$i[0]}{isadmin},
+ $rps{$i[0]}{level},
+ $rps{$i[0]}{class},
+ $rps{$i[0]}{next},
+ $rps{$i[0]}{nick},
+ $rps{$i[0]}{userhost},
+ $rps{$i[0]}{online},
+ $rps{$i[0]}{idled},
+ $rps{$i[0]}{x},
+ $rps{$i[0]}{y},
+ $rps{$i[0]}{pen_mesg},
+ $rps{$i[0]}{pen_nick},
+ $rps{$i[0]}{pen_part},
+ $rps{$i[0]}{pen_kick},
+ $rps{$i[0]}{pen_quit},
+ $rps{$i[0]}{pen_quest},
+ $rps{$i[0]}{pen_logout},
+ $rps{$i[0]}{created},
+ $rps{$i[0]}{lastlogin},
+ $rps{$i[0]}{item}{amulet},
+ $rps{$i[0]}{item}{charm},
+ $rps{$i[0]}{item}{helm},
+ $rps{$i[0]}{item}{"pair of boots"},
+ $rps{$i[0]}{item}{"pair of gloves"},
+ $rps{$i[0]}{item}{ring},
+ $rps{$i[0]}{item}{"set of leggings"},
+ $rps{$i[0]}{item}{shield},
+ $rps{$i[0]}{item}{tunic},
+ $rps{$i[0]}{item}{weapon},
+ $rps{$i[0]}{alignment}) = (@i[1..7],($sock?$i[8]:0),@i[9..$#i]);
+ }
+ close(RPS);
+ debug("loaddb(): loaded ".scalar(keys(%rps))." accounts, ".
+ scalar(keys(%prev_online))." previously online.");
+}
+
+sub moveplayers {
+ return unless $lasttime > 1;
+ my $onlinecount = grep { $rps{$_}{online} } keys %rps;
+ return unless $onlinecount;
+ for (my $i=0;$i<$opts{self_clock};++$i) {
+ # temporary hash to hold player positions, detect collisions
+ my %positions = ();
+ if ($quest{type} == 2 && @{$quest{questers}}) {
+ my $allgo = 1; # have all users reached <p1|p2>?
+ for (@{$quest{questers}}) {
+ if ($quest{stage}==1) {
+ if ($rps{$_}{x} != $quest{p1}->[0] ||
+ $rps{$_}{y} != $quest{p1}->[1]) {
+ $allgo=0;
+ last();
+ }
+ }
+ else {
+ if ($rps{$_}{x} != $quest{p2}->[0] ||
+ $rps{$_}{y} != $quest{p2}->[1]) {
+ $allgo=0;
+ last();
+ }
+ }
+ }
+ # all participants have reached point 1, now point 2
+ if ($quest{stage}==1 && $allgo) {
+ $quest{stage}=2;
+ $allgo=0; # have not all reached p2 yet
+ }
+ elsif ($quest{stage} == 2 && $allgo) {
+ chanmsg(clog(join(", ",(@{$quest{questers}})[0..2]).", ".
+ "and $quest{questers}->[3] have completed their ".
+ "journey! 25% of their burden is eliminated."));
+ for (@{$quest{questers}}) {
+ $rps{$_}{next} = int($rps{$_}{next} * .75);
+ }
+ undef(@{$quest{questers}});
+ $quest{qtime} = time() + 21600; # next quest starts in 6 hours
+ $quest{type} = 1; # probably not needed
+ writequestfile();
+ }
+ else {
+ my(%temp,$player);
+ # load keys of %temp with online users
+ ++@temp{grep { $rps{$_}{online} } keys(%rps)};
+ # delete questers from list
+ delete(@temp{@{$quest{questers}}});
+ while ($player = each(%temp)) {
+ $rps{$player}{x} += int(rand(3))-1;
+ $rps{$player}{y} += int(rand(3))-1;
+ # if player goes over edge, wrap them back around
+ if ($rps{$player}{x} > $opts{mapx}) { $rps{$player}{x}=0; }
+ if ($rps{$player}{y} > $opts{mapy}) { $rps{$player}{y}=0; }
+ if ($rps{$player}{x} < 0) { $rps{$player}{x}=$opts{mapx}; }
+ if ($rps{$player}{y} < 0) { $rps{$player}{y}=$opts{mapy}; }
+
+ if (exists($positions{$rps{$player}{x}}{$rps{$player}{y}}) &&
+ !$positions{$rps{$player}{x}}{$rps{$player}{y}}{battled}) {
+ if ($rps{$positions{$rps{$player}{x}}{$rps{$player}{y}}{user}}{isadmin} &&
+ !$rps{$player}{isadmin} && rand(100) < 1) {
+ chanmsg("$player encounters ".
+ $positions{$rps{$player}{x}}{$rps{$player}{y}}{user}.
+ " and bows humbly.");
+ }
+ if (rand($onlinecount) < 1) {
+ $positions{$rps{$player}{x}}{$rps{$player}{y}}{battled}=1;
+ collision_fight($player,
+ $positions{$rps{$player}{x}}{$rps{$player}{y}}{user});
+ }
+ }
+ else {
+ $positions{$rps{$player}{x}}{$rps{$player}{y}}{battled}=0;
+ $positions{$rps{$player}{x}}{$rps{$player}{y}}{user}=$player;
+ }
+ }
+ for (@{$quest{questers}}) {
+ if ($quest{stage} == 1) {
+ if (rand(100) < 1) {
+ if ($rps{$_}{x} != $quest{p1}->[0]) {
+ $rps{$_}{x} += ($rps{$_}{x} < $quest{p1}->[0] ?
+ 1 : -1);
+ }
+ if ($rps{$_}{y} != $quest{p1}->[1]) {
+ $rps{$_}{y} += ($rps{$_}{y} < $quest{p1}->[1] ?
+ 1 : -1);
+ }
+ }
+ }
+ elsif ($quest{stage}==2) {
+ if (rand(100) < 1) {
+ if ($rps{$_}{x} != $quest{p2}->[0]) {
+ $rps{$_}{x} += ($rps{$_}{x} < $quest{p2}->[0] ?
+ 1 : -1);
+ }
+ if ($rps{$_}{y} != $quest{p2}->[1]) {
+ $rps{$_}{y} += ($rps{$_}{y} < $quest{p2}->[1] ?
+ 1 : -1);
+ }
+ }
+ }
+ }
+ }
+ }
+ else {
+ for my $player (keys(%rps)) {
+ next unless $rps{$player}{online};
+ $rps{$player}{x} += int(rand(3))-1;
+ $rps{$player}{y} += int(rand(3))-1;
+ # if player goes over edge, wrap them back around
+ if ($rps{$player}{x} > $opts{mapx}) { $rps{$player}{x} = 0; }
+ if ($rps{$player}{y} > $opts{mapy}) { $rps{$player}{y} = 0; }
+ if ($rps{$player}{x} < 0) { $rps{$player}{x} = $opts{mapx}; }
+ if ($rps{$player}{y} < 0) { $rps{$player}{y} = $opts{mapy}; }
+ if (exists($positions{$rps{$player}{x}}{$rps{$player}{y}}) &&
+ !$positions{$rps{$player}{x}}{$rps{$player}{y}}{battled}) {
+ if ($rps{$positions{$rps{$player}{x}}{$rps{$player}{y}}{user}}{isadmin} &&
+ !$rps{$player}{isadmin} && rand(100) < 1) {
+ chanmsg("$player encounters ".
+ $positions{$rps{$player}{x}}{$rps{$player}{y}}{user}.
+ " and bows humbly.");
+ }
+ if (rand($onlinecount) < 1) {
+ $positions{$rps{$player}{x}}{$rps{$player}{y}}{battled}=1;
+ collision_fight($player,
+ $positions{$rps{$player}{x}}{$rps{$player}{y}}{user});
+ }
+ }
+ else {
+ $positions{$rps{$player}{x}}{$rps{$player}{y}}{battled}=0;
+ $positions{$rps{$player}{x}}{$rps{$player}{y}}{user}=$player;
+ }
+ }
+ }
+ }
+}
+
+sub mksalt { # generate a random salt for passwds
+ join '',('a'..'z','A'..'Z','0'..'9','/','.')[rand(64), rand(64)];
+}
+
+sub chanmsg { # send a message to the channel
+ my $msg = shift or return undef;
+ if ($silentmode & 1) { return undef; }
+ privmsg($msg, $opts{botchan}, shift);
+}
+
+sub privmsg { # send a message to an arbitrary entity
+ my $msg = shift or return undef;
+ my $target = shift or return undef;
+ my $force = shift;
+ if (($silentmode == 3 || ($target !~ /^[\+\&\#]/ && $silentmode == 2))
+ && !$force) {
+ return undef;
+ }
+ while (length($msg)) {
+ sts("PRIVMSG $target :".substr($msg,0,450),$force);
+ substr($msg,0,450)="";
+ }
+}
+
+sub notice { # send a notice to an arbitrary entity
+ my $msg = shift or return undef;
+ my $target = shift or return undef;
+ my $force = shift;
+ if (($silentmode == 3 || ($target !~ /^[\+\&\#]/ && $silentmode == 2))
+ && !$force) {
+ return undef;
+ }
+ while (length($msg)) {
+ sts("NOTICE $target :".substr($msg,0,450),$force);
+ substr($msg,0,450)="";
+ }
+}
+
+sub help { # print help message
+ (my $prog = $0) =~ s/^.*\///;
+
+ print "
+usage: $prog [OPTIONS]
+ --help, -h Print this message
+ --verbose, -v Print verbose messages
+ --server, -s Specify IRC server:port to connect to
+ --botnick, -n Bot's IRC nick
+ --botuser, -u Bot's username
+ --botrlnm, -r Bot's real name
+ --botchan, -c IRC channel to join
+ --botident, -p Specify identify-to-services command
+ --botmodes, -m Specify usermodes for the bot to set upon connect
+ --botopcmd, -o Specify command to send to server on successful connect
+ --botghostcmd, -g Specify command to send to server to regain primary
+ nickname when in use
+ --doban Advertisement ban on/off flag
+ --okurl, -k Bot will not ban for web addresses that contain these
+ strings
+ --debug Debug on/off flag
+ --helpurl URL to refer new users to
+ --admincommurl URL to refer admins to
+
+ Timing parameters:
+ --rpbase Base time to level up
+ --rpstep Time to next level = rpbase * (rpstep ** CURRENT_LEVEL)
+ --rppenstep PENALTY_SECS=(PENALTY*(RPPENSTEP**CURRENT_LEVEL))
+
+";
+}
+
+sub itemsum {
+ my $user = shift;
+ # is this for a battle? if so, good users get a 10% boost and evil users get
+ # a 10% detriment
+ my $battle = shift;
+ return -1 unless defined $user;
+ my $sum = 0;
+ if ($user eq $primnick) {
+ for my $u (keys(%rps)) {
+ $sum = itemsum($u) if $sum < itemsum($u);
+ }
+ return $sum+1;
+ }
+ if (!exists($rps{$user})) { return -1; }
+ $sum += int($rps{$user}{item}{$_}) for keys(%{$rps{$user}{item}});
+ if ($battle) {
+ return $rps{$user}{alignment} eq 'e' ? int($sum*.9) :
+ $rps{$user}{alignment} eq 'g' ? int($sum*1.1) :
+ $sum;
+ }
+ return $sum;
+}
+
+sub daemonize() {
+ # win32 doesn't daemonize (this way?)
+ if ($^O eq "MSWin32") {
+ print debug("Nevermind, this is Win32, no I'm not.")."\n";
+ return;
+ }
+ use POSIX 'setsid';
+ $SIG{CHLD} = sub { };
+ fork() && exit(0); # kill parent
+ POSIX::setsid() || debug("POSIX::setsid() failed: $!",1);
+ $SIG{CHLD} = sub { };
+ fork() && exit(0); # kill the parent as the process group leader
+ $SIG{CHLD} = sub { };
+ open(STDIN,'/dev/null') || debug("Cannot read /dev/null: $!",1);
+ open(STDOUT,'>/dev/null') || debug("Cannot write to /dev/null: $!",1);
+ open(STDERR,'>/dev/null') || debug("Cannot write to /dev/null: $!",1);
+ # write our PID to $opts{pidfile}, or return semi-silently on failure
+ open(PIDFILE,">$opts{pidfile}") || do {
+ debug("Error: failed opening pid file: $!");
+ return;
+ };
+ print PIDFILE $$;
+ close(PIDFILE);
+}
+
+sub calamity { # suffer a little one
+ my @players = grep { $rps{$_}{online} } keys(%rps);
+ return unless @players;
+ my $player = $players[rand(@players)];
+ if (rand(10) < 1) {
+ my @items = ("amulet","charm","weapon","tunic","set of leggings",
+ "shield");
+ my $type = $items[rand(@items)];
+ if ($type eq "amulet") {
+ chanmsg(clog("$player fell, chipping the stone in his amulet! ".
+ "$player\'s $type loses 10% of its effectiveness."));
+ }
+ elsif ($type eq "charm") {
+ chanmsg(clog("$player slipped and dropped his charm in a dirty ".
+ "bog! $player\'s $type loses 10% of its ".
+ "effectiveness."));
+ }
+ elsif ($type eq "weapon") {
+ chanmsg(clog("$player left his weapon out in the rain to rust! ".
+ "$player\'s $type loses 10% of its effectiveness."));
+ }
+ elsif ($type eq "tunic") {
+ chanmsg(clog("$player spilled a level 7 shrinking potion on his ".
+ "tunic! $player\'s $type loses 10% of its ".
+ "effectiveness."));
+ }
+ elsif ($type eq "shield") {
+ chanmsg(clog("$player\'s shield was damaged by a dragon's fiery ".
+ "breath! $player\'s $type loses 10% of its ".
+ "effectiveness."));
+ }
+ else {
+ chanmsg(clog("$player burned a hole through his leggings while ".
+ "ironing them! $player\'s $type loses 10% of its ".
+ "effectiveness."));
+ }
+ my $suffix="";
+ if ($rps{$player}{item}{$type} =~ /(\D)$/) { $suffix=$1; }
+ $rps{$player}{item}{$type} = int(int($rps{$player}{item}{$type}) * .9);
+ $rps{$player}{item}{$type}.=$suffix;
+ }
+ else {
+ my $time = int(int(5 + rand(8)) / 100 * $rps{$player}{next});
+ if (!open(Q,$opts{eventsfile})) {
+ return chanmsg("ERROR: Failed to open $opts{eventsfile}: $!");
+ }
+ my($i,$actioned);
+ while (my $line = <Q>) {
+ chomp($line);
+ if ($line =~ /^C (.*)/ && rand(++$i) < 1) { $actioned = $1; }
+ }
+ chanmsg(clog("$player $actioned. This terrible calamity has slowed ".
+ "them ".duration($time)." from level ".
+ ($rps{$player}{level}+1)."."));
+ $rps{$player}{next} += $time;
+ chanmsg("$player reaches next level in ".duration($rps{$player}{next}).
+ ".");
+ }
+}
+
+sub godsend { # bless the unworthy
+ my @players = grep { $rps{$_}{online} } keys(%rps);
+ return unless @players;
+ my $player = $players[rand(@players)];
+ if (rand(10) < 1) {
+ my @items = ("amulet","charm","weapon","tunic","set of leggings",
+ "shield");
+ my $type = $items[rand(@items)];
+ if ($type eq "amulet") {
+ chanmsg(clog("$player\'s amulet was blessed by a passing cleric! ".
+ "$player\'s $type gains 10% effectiveness."));
+ }
+ elsif ($type eq "charm") {
+ chanmsg(clog("$player\'s charm ate a bolt of lightning! ".
+ "$player\'s $type gains 10% effectiveness."));
+ }
+ elsif ($type eq "weapon") {
+ chanmsg(clog("$player sharpened the edge of his weapon! ".
+ "$player\'s $type gains 10% effectiveness."));
+ }
+ elsif ($type eq "tunic") {
+ chanmsg(clog("A magician cast a spell of Rigidity on $player\'s ".
+ "tunic! $player\'s $type gains 10% effectiveness."));
+ }
+ elsif ($type eq "shield") {
+ chanmsg(clog("$player reinforced his shield with a dragon's ".
+ "scales! $player\'s $type gains 10% effectiveness."));
+ }
+ else {
+ chanmsg(clog("The local wizard imbued $player\'s pants with a ".
+ "Spirit of Fortitude! $player\'s $type gains 10% ".
+ "effectiveness."));
+ }
+ my $suffix="";
+ if ($rps{$player}{item}{$type} =~ /(\D)$/) { $suffix=$1; }
+ $rps{$player}{item}{$type} = int(int($rps{$player}{item}{$type}) * 1.1);
+ $rps{$player}{item}{$type}.=$suffix;
+ }
+ else {
+ my $time = int(int(5 + rand(8)) / 100 * $rps{$player}{next});
+ my $actioned;
+ if (!open(Q,$opts{eventsfile})) {
+ return chanmsg("ERROR: Failed to open $opts{eventsfile}: $!");
+ }
+ my $i;
+ while (my $line = <Q>) {
+ chomp($line);
+ if ($line =~ /^G (.*)/ && rand(++$i) < 1) {
+ $actioned = $1;
+ }
+ }
+ chanmsg(clog("$player $actioned! This wondrous godsend has ".
+ "accelerated them ".duration($time)." towards level ".
+ ($rps{$player}{level}+1)."."));
+ $rps{$player}{next} -= $time;
+ chanmsg("$player reaches next level in ".duration($rps{$player}{next}).
+ ".");
+ }
+}
+
+sub quest {
+ @{$quest{questers}} = grep { $rps{$_}{online} && $rps{$_}{level} > 39 &&
+ time()-$rps{$_}{lastlogin}>36000 } keys(%rps);
+ if (@{$quest{questers}} < 4) { return undef(@{$quest{questers}}); }
+ while (@{$quest{questers}} > 4) {
+ splice(@{$quest{questers}},int(rand(@{$quest{questers}})),1);
+ }
+ if (!open(Q,$opts{eventsfile})) {
+ return chanmsg("ERROR: Failed to open $opts{eventsfile}: $!");
+ }
+ my $i;
+ while (my $line = <Q>) {
+ chomp($line);
+ if ($line =~ /^Q/ && rand(++$i) < 1) {
+ if ($line =~ /^Q1 (.*)/) {
+ $quest{text} = $1;
+ $quest{type} = 1;
+ $quest{qtime} = time() + 43200 + int(rand(43201)); # 12-24 hours
+ }
+ elsif ($line =~ /^Q2 (\d+) (\d+) (\d+) (\d+) (.*)/) {
+ $quest{p1} = [$1,$2];
+ $quest{p2} = [$3,$4];
+ $quest{text} = $5;
+ $quest{type} = 2;
+ $quest{stage} = 1;
+ }
+ }
+ }
+ close(Q);
+ if ($quest{type} == 1) {
+ chanmsg(join(", ",(@{$quest{questers}})[0..2]).", and ".
+ "$quest{questers}->[3] have been chosen by the gods to ".
+ "$quest{text}. Quest to end in ".duration($quest{qtime}-time()).
+ ".");
+ }
+ elsif ($quest{type} == 2) {
+ chanmsg(join(", ",(@{$quest{questers}})[0..2]).", and ".
+ "$quest{questers}->[3] have been chosen by the gods to ".
+ "$quest{text}. Participants must first reach [$quest{p1}->[0],".
+ "$quest{p1}->[1]], then [$quest{p2}->[0],$quest{p2}->[1]].".
+ ($opts{mapurl}?" See $opts{mapurl} to monitor their journey's ".
+ "progress.":""));
+ }
+ writequestfile();
+}
+
+sub questpencheck {
+ my $k = shift;
+ my ($quester,$player);
+ for $quester (@{$quest{questers}}) {
+ if ($quester eq $k) {
+ chanmsg(clog("$k\'s prudence and self-regard has brought the ".
+ "wrath of the gods upon the realm. All your great ".
+ "wickedness makes you as it were heavy with lead, ".
+ "and to tend downwards with great weight and ".
+ "pressure towards hell. Therefore have you drawn ".
+ "yourselves 15 steps closer to that gaping maw."));
+ for $player (grep { $rps{$_}{online} } keys %rps) {
+ my $gain = int(15 * ($opts{rppenstep}**$rps{$player}{level}));
+ $rps{$player}{pen_quest} += $gain;
+ $rps{$player}{next} += $gain;
+ }
+ undef(@{$quest{questers}});
+ $quest{qtime} = time() + 43200; # 12 hours
+ }
+ }
+}
+
+sub clog {
+ my $mesg = shift;
+ open(B,">>$opts{modsfile}") or do {
+ debug("Error: Cannot open $opts{modsfile}: $!");
+ chanmsg("Error: Cannot open $opts{modsfile}: $!");
+ return $mesg;
+ };
+ print B ts()."$mesg\n";
+ close(B);
+ return $mesg;
+}
+
+sub backup() {
+ if (! -d ".dbbackup/") { mkdir(".dbbackup",0700); }
+ if ($^O ne "MSWin32") {
+ system("cp $opts{dbfile} .dbbackup/$opts{dbfile}".time());
+ }
+ else {
+ system("copy $opts{dbfile} .dbbackup\\$opts{dbfile}".time());
+ }
+}
+
+sub penalize {
+ my $username = shift;
+ return 0 if !defined($username);
+ return 0 if !exists($rps{$username});
+ my $type = shift;
+ my $pen = 0;
+ questpencheck($username);
+ if ($type eq "quit") {
+ $pen = int(20 * ($opts{rppenstep}**$rps{$username}{level}));
+ if ($opts{limitpen} && $pen > $opts{limitpen}) {
+ $pen = $opts{limitpen};
+ }
+ $rps{$username}{pen_quit}+=$pen;
+ $rps{$username}{online}=0;
+ }
+ elsif ($type eq "nick") {
+ my $newnick = shift;
+ $pen = int(30 * ($opts{rppenstep}**$rps{$username}{level}));
+ if ($opts{limitpen} && $pen > $opts{limitpen}) {
+ $pen = $opts{limitpen};
+ }
+ $rps{$username}{pen_nick}+=$pen;
+ $rps{$username}{nick} = substr($newnick,1);
+ substr($rps{$username}{userhost},0,length($rps{$username}{nick})) =
+ substr($newnick,1);
+ notice("Penalty of ".duration($pen)." added to your timer for ".
+ "nick change.",$rps{$username}{nick});
+ }
+ elsif ($type eq "privmsg" || $type eq "notice") {
+ $pen = int(shift(@_) * ($opts{rppenstep}**$rps{$username}{level}));
+ if ($opts{limitpen} && $pen > $opts{limitpen}) {
+ $pen = $opts{limitpen};
+ }
+ $rps{$username}{pen_mesg}+=$pen;
+ notice("Penalty of ".duration($pen)." added to your timer for ".
+ $type.".",$rps{$username}{nick});
+ }
+ elsif ($type eq "part") {
+ $pen = int(200 * ($opts{rppenstep}**$rps{$username}{level}));
+ if ($opts{limitpen} && $pen > $opts{limitpen}) {
+ $pen = $opts{limitpen};
+ }
+ $rps{$username}{pen_part}+=$pen;
+ notice("Penalty of ".duration($pen)." added to your timer for ".
+ "parting.",$rps{$username}{nick});
+ $rps{$username}{online}=0;
+ }
+ elsif ($type eq "kick") {
+ $pen = int(250 * ($opts{rppenstep}**$rps{$username}{level}));
+ if ($opts{limitpen} && $pen > $opts{limitpen}) {
+ $pen = $opts{limitpen};
+ }
+ $rps{$username}{pen_kick}+=$pen;
+ notice("Penalty of ".duration($pen)." added to your timer for ".
+ "being kicked.",$rps{$username}{nick});
+ $rps{$username}{online}=0;
+ }
+ elsif ($type eq "logout") {
+ $pen = int(20 * ($opts{rppenstep}**$rps{$username}{level}));
+ if ($opts{limitpen} && $pen > $opts{limitpen}) {
+ $pen = $opts{limitpen};
+ }
+ $rps{$username}{pen_logout} += $pen;
+ notice("Penalty of ".duration($pen)." added to your timer for ".
+ "LOGOUT command.",$rps{$username}{nick});
+ $rps{$username}{online}=0;
+ }
+ $rps{$username}{next} += $pen;
+ return 1; # successfully penalized a user! woohoo!
+}
+
+sub debug {
+ (my $text = shift) =~ s/[\r\n]//g;
+ my $die = shift;
+ if ($opts{debug} || $opts{verbose}) {
+ open(DBG,">>$opts{debugfile}") or do {
+ chanmsg("Error: Cannot open debug file: $!");
+ return;
+ };
+ print DBG ts()."$text\n";
+ close(DBG);
+ }
+ if ($die) { die("$text\n"); }
+ return $text;
+}
+
+sub finduser {
+ my $nick = shift;
+ return undef if !defined($nick);
+ for my $user (keys(%rps)) {
+ next unless $rps{$user}{online};
+ if ($rps{$user}{nick} eq $nick) { return $user; }
+ }
+ return undef;
+}
+
+sub ha { # return 0/1 if username has access
+ my $user = shift;
+ if (!defined($user) || !exists($rps{$user})) {
+ debug("Error: Attempted ha() for invalid username \"$user\"");
+ return 0;
+ }
+ return $rps{$user}{isadmin};
+}
+
+sub checksplits { # removed expired split hosts from the hash
+ my $host;
+ while ($host = each(%split)) {
+ if (time()-$split{$host}{time} > $opts{splitwait}) {
+ $rps{$split{$host}{account}}{online} = 0;
+ delete($split{$host});
+ }
+ }
+}
+
+sub collision_fight {
+ my($u,$opp) = @_;
+ my $mysum = itemsum($u,1);
+ my $oppsum = itemsum($opp,1);
+ my $myroll = int(rand($mysum));
+ my $opproll = int(rand($oppsum));
+ if ($myroll >= $opproll) {
+ my $gain = int($rps{$opp}{level}/4);
+ $gain = 7 if $gain < 7;
+ $gain = int(($gain/100)*$rps{$u}{next});
+ chanmsg(clog("$u [$myroll/$mysum] has come upon $opp [$opproll/$oppsum".
+ "] and taken them in combat! ".duration($gain)." is ".
+ "removed from $u\'s clock."));
+ $rps{$u}{next} -= $gain;
+ chanmsg("$u reaches next level in ".duration($rps{$u}{next}).".");
+ if (rand(35) < 1 && $opp ne $primnick) {
+ $gain = int(((5 + int(rand(20)))/100) * $rps{$opp}{next});
+ chanmsg(clog("$u has dealt $opp a Critical Strike! ".
+ duration($gain)." is added to $opp\'s clock."));
+ $rps{$opp}{next} += $gain;
+ chanmsg("$opp reaches next level in ".duration($rps{$opp}{next}).
+ ".");
+ }
+ elsif (rand(25) < 1 && $opp ne $primnick && $rps{$u}{level} > 19) {
+ my @items = ("ring","amulet","charm","weapon","helm","tunic",
+ "pair of gloves","set of leggings","shield",
+ "pair of boots");
+ my $type = $items[rand(@items)];
+ if (int($rps{$opp}{item}{$type}) > int($rps{$u}{item}{$type})) {
+ chanmsg("In the fierce battle, $opp dropped his level ".
+ int($rps{$opp}{item}{$type})." $type! $u picks it up, ".
+ "tossing his old level ".int($rps{$u}{item}{$type}).
+ " $type to $opp.");
+ my $tempitem = $rps{$u}{item}{$type};
+ $rps{$u}{item}{$type}=$rps{$opp}{item}{$type};
+ $rps{$opp}{item}{$type} = $tempitem;
+ }
+ }
+ }
+ else {
+ my $gain = ($opp eq $primnick)?10:int($rps{$opp}{level}/7);
+ $gain = 7 if $gain < 7;
+ $gain = int(($gain/100)*$rps{$u}{next});
+ chanmsg(clog("$u [$myroll/$mysum] has come upon $opp [$opproll/$oppsum".
+ "] and been defeated in combat! ".duration($gain)." is ".
+ "added to $u\'s clock."));
+ $rps{$u}{next} += $gain;
+ chanmsg("$u reaches next level in ".duration($rps{$u}{next}).".");
+ }
+}
+
+sub writequestfile {
+ return unless $opts{writequestfile};
+ open(QF,">$opts{questfilename}") or do {
+ chanmsg("Error: Cannot open $opts{questfilename}: $!");
+ return;
+ };
+ # if no active quest, just empty questfile. otherwise, write it
+ if (@{$quest{questers}}) {
+ if ($quest{type}==1) {
+ print QF "T $quest{text}\n".
+ "Y 1\n".
+ "S $quest{qtime}\n".
+ "P1 $quest{questers}->[0]\n".
+ "P2 $quest{questers}->[1]\n".
+ "P3 $quest{questers}->[2]\n".
+ "P4 $quest{questers}->[3]\n";
+ }
+ elsif ($quest{type}==2) {
+ print QF "T $quest{text}\n".
+ "Y 2\n".
+ "S $quest{stage}\n".
+ "P $quest{p1}->[0] $quest{p1}->[1] $quest{p2}->[0] ".
+ "$quest{p2}->[1]\n".
+ "P1 $quest{questers}->[0] $rps{$quest{questers}->[0]}{x} ".
+ "$rps{$quest{questers}->[0]}{y}\n".
+ "P2 $quest{questers}->[1] $rps{$quest{questers}->[1]}{x} ".
+ "$rps{$quest{questers}->[1]}{y}\n".
+ "P3 $quest{questers}->[2] $rps{$quest{questers}->[2]}{x} ".
+ "$rps{$quest{questers}->[2]}{y}\n".
+ "P4 $quest{questers}->[3] $rps{$quest{questers}->[3]}{x} ".
+ "$rps{$quest{questers}->[3]}{y}\n";
+ }
+ }
+ close(QF);
+}
+
+sub goodness {
+ my @players = grep { $rps{$_}{alignment} eq "g" &&
+ $rps{$_}{online} } keys(%rps);
+ return unless @players > 1;
+ splice(@players,int(rand(@players)),1) while @players > 2;
+ my $gain = 5 + int(rand(8));
+ chanmsg(clog("$players[0] and $players[1] have not let the iniquities of ".
+ "evil men poison them. Together have they prayed to their ".
+ "god, and it is his light that now shines upon them. $gain\% ".
+ "of their time is removed from their clocks."));
+ $rps{$players[0]}{next} = int($rps{$players[0]}{next}*(1 - ($gain/100)));
+ $rps{$players[1]}{next} = int($rps{$players[1]}{next}*(1 - ($gain/100)));
+ chanmsg("$players[0] reaches next level in ".
+ duration($rps{$players[0]}{next}).".");
+ chanmsg("$players[1] reaches next level in ".
+ duration($rps{$players[1]}{next}).".");
+}
+
+sub evilness {
+ my @evil = grep { $rps{$_}{alignment} eq "e" &&
+ $rps{$_}{online} } keys(%rps);
+ return unless @evil;
+ my $me = $evil[rand(@evil)];
+ if (int(rand(2)) < 1) {
+ # evil only steals from good :^(
+ my @good = grep { $rps{$_}{alignment} eq "g" &&
+ $rps{$_}{online} } keys(%rps);
+ my $target = $good[rand(@good)];
+ my @items = ("ring","amulet","charm","weapon","helm","tunic",
+ "pair of gloves","set of leggings","shield",
+ "pair of boots");
+ my $type = $items[rand(@items)];
+ if (int($rps{$target}{item}{$type}) > int($rps{$me}{item}{$type})) {
+ my $tempitem = $rps{$me}{item}{$type};
+ $rps{$me}{item}{$type} = $rps{$target}{item}{$type};
+ $rps{$target}{item}{$type} = $tempitem;
+ chanmsg(clog("$me stole $target\'s level ".
+ int($rps{$me}{item}{$type})." $type while they were ".
+ "sleeping! $me leaves his old level ".
+ int($rps{$target}{item}{$type})." $type behind, ".
+ "which $target then takes."));
+ }
+ else {
+ notice("You made to steal $target\'s $type, but realized it was ".
+ "lower level than your own. You creep back into the ".
+ "shadows.",$rps{$me}{nick});
+ }
+ }
+ else { # being evil only pays about half of the time...
+ my $gain = 1 + int(rand(5));
+ chanmsg(clog("$me is forsaken by his evil god. ".
+ duration(int($rps{$me}{next} * ($gain/100)))." is added ".
+ "to his clock."));
+ $rps{$me}{next} = int($rps{$me}{next} * (1 + ($gain/100)));
+ chanmsg("$me reaches next level in ".duration($rps{$me}{next}).".");
+ }
+}
+
+sub fisher_yates_shuffle {
+ my $array = shift;
+ my $i;
+ for ($i = @$array; --$i; ) {
+ my $j = int rand ($i+1);
+ next if $i == $j;
+ @$array[$i,$j] = @$array[$j,$i];
+ }
+}
+
+sub writedb {
+ open(RPS,">$opts{dbfile}") or do {
+ chanmsg("ERROR: Cannot write $opts{dbfile}: $!");
+ return 0;
+ };
+ print RPS join("\t","# username",
+ "pass",
+ "is admin",
+ "level",
+ "class",
+ "next ttl",
+ "nick",
+ "userhost",
+ "online",
+ "idled",
+ "x pos",
+ "y pos",
+ "pen_mesg",
+ "pen_nick",
+ "pen_part",
+ "pen_kick",
+ "pen_quit",
+ "pen_quest",
+ "pen_logout",
+ "created",
+ "last login",
+ "amulet",
+ "charm",
+ "helm",
+ "boots",
+ "gloves",
+ "ring",
+ "leggings",
+ "shield",
+ "tunic",
+ "weapon",
+ "alignment")."\n";
+ my $k;
+ keys(%rps); # reset internal pointer
+ while ($k=each(%rps)) {
+ if (exists($rps{$k}{next}) && defined($rps{$k}{next})) {
+ print RPS join("\t",$k,
+ $rps{$k}{pass},
+ $rps{$k}{isadmin},
+ $rps{$k}{level},
+ $rps{$k}{class},
+ $rps{$k}{next},
+ $rps{$k}{nick},
+ $rps{$k}{userhost},
+ $rps{$k}{online},
+ $rps{$k}{idled},
+ $rps{$k}{x},
+ $rps{$k}{y},
+ $rps{$k}{pen_mesg},
+ $rps{$k}{pen_nick},
+ $rps{$k}{pen_part},
+ $rps{$k}{pen_kick},
+ $rps{$k}{pen_quit},
+ $rps{$k}{pen_quest},
+ $rps{$k}{pen_logout},
+ $rps{$k}{created},
+ $rps{$k}{lastlogin},
+ $rps{$k}{item}{amulet},
+ $rps{$k}{item}{charm},
+ $rps{$k}{item}{helm},
+ $rps{$k}{item}{"pair of boots"},
+ $rps{$k}{item}{"pair of gloves"},
+ $rps{$k}{item}{ring},
+ $rps{$k}{item}{"set of leggings"},
+ $rps{$k}{item}{shield},
+ $rps{$k}{item}{tunic},
+ $rps{$k}{item}{weapon},
+ $rps{$k}{alignment})."\n";
+ }
+ }
+ close(RPS);
+}
+
+sub readconfig {
+ if (! -e ".irpg.conf") {
+ debug("Error: Cannot find .irpg.conf. Copy it to this directory, ".
+ "please.",1);
+ }
+ else {
+ open(CONF,"<.irpg.conf") or do {
+ debug("Failed to open config file .irpg.conf: $!",1);
+ };
+ my($line,$key,$val);
+ while ($line=<CONF>) {
+ next() if $line =~ /^#/; # skip comments
+ $line =~ s/[\r\n]//g;
+ $line =~ s/^\s+//g;
+ next() if !length($line); # skip blank lines
+ ($key,$val) = split(/\s+/,$line,2);
+ $key = lc($key);
+ if (lc($val) eq "on" || lc($val) eq "yes") { $val = 1; }
+ elsif (lc($val) eq "off" || lc($val) eq "no") { $val = 0; }
+ if ($key eq "die") {
+ die("Please edit the file .irpg.conf to setup your bot's ".
+ "options. Also, read the README file if you haven't ".
+ "yet.\n");
+ }
+ elsif ($key eq "server") { push(@{$opts{servers}},$val); }
+ elsif ($key eq "okurl") { push(@{$opts{okurl}},$val); }
+ else { $opts{$key} = $val; }
+ }
+ }
+}
diff --git a/events.txt b/events.txt
new file mode 100644
index 0000000..becb890
--- /dev/null
+++ b/events.txt
@@ -0,0 +1,71 @@
+C was bitten by drdink
+C fell into a hole
+C bit their tongue
+C set themself on fire
+C ate a poisonous fruit
+C lost their mind
+C died, temporarily..
+C was caught in a terrible snowstorm
+C EXPLODED, somewhat..
+C got knifed in a dark alley
+C saw an episode of Ally McBeal
+C got turned INSIDE OUT, practically
+C ate a very disagreeable fruit, getting a terrible case of heartburn
+C met up with a mob hitman for not paying his bills
+C has fallen ill with the black plague
+C was struck by lightning
+C was attacked by a rabid cow
+C was attacked by a rabid wolverine
+C was set on fire
+C was decapitated, temporarily..
+C was tipped by a cow
+C was bucked from a horse
+C was bitten by a møøse
+C was sat on by a giant
+C ate a plate of discounted, day-old sushi
+C got harassed by peer
+C got lost in the woods
+C misplaced his map
+C broke his compass
+C lost his glasses
+C walked face-first into a tree
+G found a pair of Nikes
+G caught a unicorn
+G discovered a secret, underground passage
+G was taught to run quickly by a secret tribe of pygmies that know how to, among other things, run quickly
+G discovered caffeinated coffee
+G grew an extra leg
+G was visited by a very pretty nymph
+G found kitten
+G learned Perl
+G found an exploit in the IRPG code
+G tamed a wild horse
+G found a one-time-use spell of quickness
+G bought a faster computer
+G bribed the local IRPG administrator
+G stopped using dial-up
+G invented the wheel
+G gained a sixth sense
+G got a kiss from drwiii
+G had his clothes laundered by a passing fairy
+G was rejuvenated by drinking from a magic stream
+G was bitten by a radioactive spider
+G hit it off with a drunk sorority chick named Jenny
+G was accepted into Pi Beta Phi
+Q2 225 415 280 460 lay waste to the Towers of Ankh-Allor, wherein lies the terrible sorceror Croocq
+Q1 locate the centuries-lost tomes of the grim prophet Haplashak Mhadhu
+Q2 400 475 480 380 explore and chart the dark lands of T'rnalvph
+Q1 locate the ancient writings of Ahmo, prophet of the blind god Io, namely his last and hidden work, Time as Deity, thought to answer all of mankind's greater wonders
+Q2 290 65 325 270 slay the great and horrible troll, Dokt'r Wiii
+Q2 480 415 325 270 return the stolen relics of Iao-Sabao to the city of Velvragh, quieting the religious riot that has sprung up from their loss
+Q2 70 315 325 270 guard the secret passage to Bharash until the full moon has passed, and the evil returned to its resting place
+Q2 50 350 325 270 destroy the bandits terrorizing the roads passing through the Great Shahlil mountains
+Q1 locate and destroy the immensely powerful Eyeless Amulet of the evil sorceress, Ankh B'loht
+Q2 167 458 325 270 rescue the beautiful princess Juliet from the grasp of the beast Grabthul
+Q1 locate the herbs and brew the elixir to rid the realm of the Normonic Plague
+Q2 160 480 160 380 hunt down the over-abundance of mountain wolves that are slaying the regions' cows
+Q2 35 40 325 270 assassinate the general, Ronald Ashur, of the invading army of Denmark
+Q2 235 125 430 60 setup a trade route through the mountains to the neighboring land of Qwok and arrange correspondence with their leader, Cuincey-Love Vikk'l
+Q2 155 155 325 270 live among and learn the ancient magick of the tribe of pygmie people, the Jow Botzi
+Q2 70 125 170 100 kill the resurrected Jow Botzian zombies produced by a young wizard's wayward spell
+Q1 worship the sacred Cow until such time as she is satiated
diff --git a/irpgdbtool b/irpgdbtool
new file mode 100644
index 0000000..c339a6c
--- /dev/null
+++ b/irpgdbtool
@@ -0,0 +1,469 @@
+# IRPG db conversion tool; converts db version 2.4 -> 3.0
+# Jon Honeycutt, jotun@idlerpg.net, http://idlerpg.net
+# Free for all use, public and private, with retention of copyright notice.
+
+use strict;
+use IO::Socket;
+
+my %rps = ();
+my $temp;
+
+$|=1;
+
+print "\nIRPG db conversion tool; version 2.4 -> 3.0\n\n";
+
+do {
+ print "Read from file [irpg.db]: ";
+ chomp($temp=<STDIN>);
+ $temp ||= "irpg.db";
+ if (! -e $temp) { print "Error: No such file\n"; }
+} until (-e $temp);
+
+loaddb($temp);
+
+print "Loaded ".scalar(keys(%rps))." accounts from $temp.\n";
+
+do {
+ print "\nBackup old irpg.db file? [yes]: ";
+ chomp($temp=<STDIN>);
+ $temp||="yes";
+ $temp=lc($temp);
+} until ($temp eq "yes" || $temp eq "no");
+
+if ($temp eq "yes") {
+ do {
+ print "\nBackup filename [irpg.db.old]: ";
+ chomp($temp=<STDIN>);
+ $temp||="irpg.db.old";
+ } until (defined($temp));
+ open(RPS,">$temp") or die("Cannot write $temp: $!");
+ print RPS "# username\tpass\tlevel\tclass\tnext\tnick\tuserhost\tonline\t".
+ "idled\tpen_mesg\tpen_nick\tpen_part\tpen_kick\tpen_quit\t".
+ "pen_quest\tpen_logout\tcreated\tlast login\tamulet\tcharm\t".
+ "helm\tboots\tgloves\tring\tleggings\tshield\ttunic\tweapon\n";
+ for my $k (keys %rps) {
+ print RPS join("\t",
+ $k,
+ $rps{$k}{pass},
+ $rps{$k}{level},
+ $rps{$k}{class},
+ $rps{$k}{next},
+ $rps{$k}{nick}||"",
+ $rps{$k}{userhost}||"",
+ $rps{$k}{online}||0,
+ $rps{$k}{idled}||0,
+ $rps{$k}{pen_mesg}||0,
+ $rps{$k}{pen_nick}||0,
+ $rps{$k}{pen_part}||0,
+ $rps{$k}{pen_kick}||0,
+ $rps{$k}{pen_quit}||0,
+ $rps{$k}{pen_quest}||0,
+ $rps{$k}{pen_logout}||0,
+ $rps{$k}{created},
+ $rps{$k}{lastlogin},
+ $rps{$k}{item}{amulet}||0,
+ $rps{$k}{item}{charm}||0,
+ $rps{$k}{item}{helm}||0,
+ $rps{$k}{item}{"pair of boots"}||0,
+ $rps{$k}{item}{"pair of gloves"}||0,
+ $rps{$k}{item}{ring}||0,
+ $rps{$k}{item}{"set of leggings"}||0,
+ $rps{$k}{item}{shield}||0,
+ $rps{$k}{item}{tunic}||0,
+ $rps{$k}{item}{weapon}||0)."\n";
+ }
+ close(RPS);
+ print "Wrote $temp.\n";
+}
+
+do {
+ print "\nReset all user levels to 0, all times to level to 0, all items ".
+ "to 0, all penalties to 0, all online flags to 0, all idled times ".
+ "to 0, all creation dates and last login times to today (i.e., ".
+ "reset game)? [no]: ";
+ chomp($temp=<STDIN>);
+ $temp||="no";
+ $temp=lc($temp);
+} until ($temp eq "yes" || $temp eq "no");
+
+if ($temp eq "yes") {
+ for my $k (keys(%rps)) {
+ $rps{$k}{next}=0;
+ $rps{$k}{level}=0;
+ $rps{$k}{online}=0;
+ $rps{$k}{idled}=0;
+ $rps{$k}{item}{amulet}=0;
+ $rps{$k}{item}{charm}=0;
+ $rps{$k}{item}{helm}=0;
+ $rps{$k}{item}{"pair of boots"}=0;
+ $rps{$k}{item}{"pair of gloves"}=0;
+ $rps{$k}{item}{ring}=0;
+ $rps{$k}{item}{"set of leggings"}=0;
+ $rps{$k}{item}{shield}=0;
+ $rps{$k}{item}{tunic}=0;
+ $rps{$k}{item}{weapon}=0;
+ $rps{$k}{pen_mesg}=0;
+ $rps{$k}{pen_nick}=0;
+ $rps{$k}{pen_part}=0;
+ $rps{$k}{pen_kick}=0;
+ $rps{$k}{pen_quit}=0;
+ $rps{$k}{pen_quest}=0;
+ $rps{$k}{pen_logout}=0;
+ $rps{$k}{created}=time();
+ $rps{$k}{lastlogin}=time();
+ }
+ print "Game reset.\n";
+}
+
+do {
+ print "\nStrip all control codes from character names and classes? [no]: ";
+ chomp($temp=<STDIN>);
+ $temp ||="no";
+ $temp=lc($temp);
+} until ($temp eq "yes" || $temp eq "no");
+
+if ($temp eq "yes") {
+ my(@usernames,@classes);
+ for my $k (keys(%rps)) {
+ if ($k =~ /[[:cntrl:]]/) {
+ my $newusername = $k;
+ $newusername =~ s/[[:cntrl:]]//g;
+ if (exists($rps{$newusername}) || !defined($newusername) ||
+ !length($newusername)) {
+ print "\nError: While trying to strip control codes from $k, ".
+ "found stripped version ($newusername) already exists ".
+ "in database or is undefined. Skipping this user, so ".
+ "sorry.\n";
+ }
+ else {
+ $rps{$newusername}=delete($rps{$k});
+ push(@usernames,"$k is now: $newusername");
+ $k = $newusername;
+ }
+ }
+ if ($rps{$k}{class} =~ /[[:cntrl:]]/) {
+ $rps{$k}{class} =~ s/[[:cntrl:]]//g;
+ push(@classes,"$k is now: $rps{$k}{class}");
+ }
+ }
+ if (@usernames) {
+ print "\nUsernames changed (would be good to alert these users):\n";
+ print "User $_\n" for @usernames;
+ print "\n";
+ }
+ if (@classes) {
+ print "\nClass names changed (might be good to alert these users):\n";
+ print "User $_\n" for @classes;
+ print "\n";
+ }
+}
+
+do {
+ print "\nStrip all non-printable characters from character names and ".
+ "classes? [no]: ";
+ chomp($temp=<STDIN>);
+ $temp ||="no";
+ $temp=lc($temp);
+} until ($temp eq "yes" || $temp eq "no");
+
+if ($temp eq "yes") {
+ my(@usernames,@classes);
+ for my $k (keys(%rps)) {
+ if ($k =~ /[[:^print:]]/) {
+ my $newusername = $k;
+ $newusername =~ s/[[:^print:]]//g;
+ if (exists($rps{$newusername}) || !defined($newusername) ||
+ !length($newusername)) {
+ print "\nError: While trying to strip non-printable chars ".
+ "from $k, found stripped version ($newusername) already ".
+ "exists in database or is undefined. Skipping this ".
+ "user, so sorry.\n";
+ }
+ else {
+ $rps{$newusername}=delete($rps{$k});
+ push(@usernames,"$k is now: $newusername");
+ $k = $newusername;
+ }
+ }
+ if ($rps{$k}{class} =~ /[[:^print:]]/) {
+ $rps{$k}{class} =~ s/[[:^print:]]//g;
+ push(@classes,"$k\'s class is now: $rps{$k}{class}");
+ }
+ }
+ if (@usernames) {
+ print "\nUsernames changed (would be good to alert these users):\n";
+ print "User $_\n" for @usernames;
+ print "\n";
+ }
+ if (@classes) {
+ print "\nClass names changed (might be good to alert these users):\n";
+ print "User $_\n" for @classes;
+ print "\n";
+ }
+}
+
+do {
+ print "\nVersion 3.0 supports 'named items,' or a method of marking ".
+ "unique items as being unique. Attempt to name existing items that ".
+ "are known uniques? [yes]: ";
+ chomp($temp=<STDIN>);
+ $temp ||="yes";
+ $temp=lc($temp);
+} until ($temp eq "yes" || $temp eq "no");
+
+if ($temp eq "yes") {
+ for my $k (keys(%rps)) {
+ for my $item (keys(%{$rps{$k}{item}})) {
+ if ($rps{$k}{item}{$item} > int(1.5*$rps{$k}{level})) {
+ if ($item eq "helm") {
+ print "$k\'s $item named as Mattt's Omniscience.\n";
+ $rps{$k}{item}{$item} .= "a";
+ }
+ elsif ($item eq "tunic") {
+ print "$k\'s $item named as Res0's Protectorate.\n";
+ $rps{$k}{item}{$item} .= "b";
+ }
+ elsif ($item eq "amulet") {
+ print "$k\'s $item named as Dwyn's Storm.\n";
+ $rps{$k}{item}{$item} .= "c";
+ }
+ elsif ($item eq "weapon" && $rps{$k}{item}{$item} < 175) {
+ print "$k\'s $item named as Jotun's Fury.\n";
+ $rps{$k}{item}{$item} .= "d";
+ }
+ elsif ($item eq "weapon" && $rps{$k}{item}{$item} > 175 &&
+ $rps{$k}{item}{$item} < 201) {
+ print "$k\'s $item named as Drdink's Cane of Blind Rage.\n";
+ $rps{$k}{item}{$item} .= "e";
+ }
+ else {
+ print "$k has unknown unique of level ".
+ "$rps{$k}{item}{$item}.\n";
+ }
+ }
+ }
+ }
+}
+
+do {
+ print "\nThere exist new items in version 3.0 that some of your clients ".
+ "may already have had the chance to find. I.E., there is a new item ".
+ "with a required level of 48. Simulate an item find for all users ".
+ "above 48 for this and other new items to make the game fair for ".
+ "older users? [yes]: ";
+ chomp($temp=<STDIN>);
+ $temp ||="yes";
+ $temp=lc($temp);
+} until ($temp eq "yes" || $temp eq "no");
+
+if ($temp eq "yes") {
+ for my $k (keys(%rps)) {
+ if ($rps{$k}{level} >= 48) {
+ for (48..$rps{$k}{level}) {
+ # approximately equal to normal item find, i believe
+ if (rand(100) < 2.25) {
+ my $ulevel = 250+int(rand(51));
+ if ($ulevel > int($rps{$k}{item}{"pair of boots"})) {
+ print "$k found level $ulevel Mrquick's Magical Boots ".
+ "of Swiftness.\n";
+ $rps{$k}{item}{"pair of boots"} = $ulevel."f";
+ }
+ }
+ }
+ }
+ if ($rps{$k}{level} >= 52) {
+ for (52..$rps{$k}{level}) {
+ # approximately equal to normal item find, i believe
+ if (rand(100) < 2.15) {
+ my $ulevel = 300+int(rand(51));
+ if ($ulevel > int($rps{$k}{item}{weapon})) {
+ print "$k found level $ulevel Jeff's Cluehammer of ".
+ "Doom.\n";
+ $rps{$k}{item}{weapon} = $ulevel."g";
+ }
+ }
+ }
+ }
+ if ($rps{$k}{level} >= 25) {
+ for (25..$rps{$k}{level}) {
+ # approximately equal to normal item find, i believe
+ if (rand(100) < 2.43) {
+ my $ulevel = 50+int(rand(25));
+ if ($ulevel > int($rps{$k}{item}{ring})) {
+ print "$k found level $ulevel Juliet's Glorious Ring ".
+ "of Sparkliness.\n";
+ $rps{$k}{item}{ring} = $ulevel."h";
+ }
+ }
+ }
+ }
+ }
+}
+
+for my $k (keys(%rps)) {
+ $rps{$k}{x} = int(rand(500));
+ $rps{$k}{y} = int(rand(500));
+ $rps{$k}{isadmin}=0;
+ $rps{$k}{alignment}="n";
+}
+
+print "\nUsernames that you would like to have admin status (separate with ".
+ "commas, use proper CaSe): ";
+chomp($temp=<STDIN>);
+$temp =~ s/\s//g;
+for my $k (split(/,/,$temp)) {
+ if (!exists($rps{$k})) {
+ print "\nError: Account name '$k' does not exist. Remember that ".
+ "account names are case sensitive. Skipping this username. Edit ".
+ "the database manually, or use the MKADMIN command after the ".
+ "bot connects to add this user.\n\n";
+ }
+ else {
+ print "$k is now admin.\n";
+ $rps{$k}{isadmin}=1;
+ }
+}
+print "\nYou can add more admins later with the MKADMIN command.\n";
+
+do {
+ print "\nWrite to new db file [irpg.db]: ";
+ chomp($temp=<STDIN>);
+ $temp ||= "irpg.db";
+} until (defined($temp));
+
+open(RPS,">$temp") or die "Cannot open $temp: $!";
+
+print RPS join("\t","# username",
+ "pass",
+ "is admin",
+ "level",
+ "class",
+ "next ttl",
+ "nick",
+ "userhost",
+ "online",
+ "idled",
+ "x pos",
+ "y pos",
+ "pen_mesg",
+ "pen_nick",
+ "pen_part",
+ "pen_kick",
+ "pen_quit",
+ "pen_quest",
+ "pen_logout",
+ "created",
+ "last login",
+ "amulet",
+ "charm",
+ "helm",
+ "boots",
+ "gloves",
+ "ring",
+ "leggings",
+ "shield",
+ "tunic",
+ "weapon",
+ "alignment")."\n";
+
+for my $k (keys(%rps)) {
+ print RPS join("\t",
+ $k,
+ $rps{$k}{pass},
+ $rps{$k}{isadmin},
+ $rps{$k}{level},
+ $rps{$k}{class},
+ $rps{$k}{next},
+ $rps{$k}{nick},
+ $rps{$k}{userhost},
+ $rps{$k}{online},
+ $rps{$k}{idled},
+ $rps{$k}{x},
+ $rps{$k}{y},
+ $rps{$k}{pen_mesg},
+ $rps{$k}{pen_nick},
+ $rps{$k}{pen_part},
+ $rps{$k}{pen_kick},
+ $rps{$k}{pen_quit},
+ $rps{$k}{pen_quest},
+ $rps{$k}{pen_logout},
+ $rps{$k}{created},
+ $rps{$k}{lastlogin},
+ $rps{$k}{item}{amulet},
+ $rps{$k}{item}{charm},
+ $rps{$k}{item}{helm},
+ $rps{$k}{item}{"pair of boots"},
+ $rps{$k}{item}{"pair of gloves"},
+ $rps{$k}{item}{ring},
+ $rps{$k}{item}{"set of leggings"},
+ $rps{$k}{item}{shield},
+ $rps{$k}{item}{tunic},
+ $rps{$k}{item}{weapon},
+ $rps{$k}{alignment})."\n";
+}
+close(RPS);
+
+do {
+ print "\nDone writing $temp! Thanks for your interest in the Idle RPG. May ".
+ "I send an (anonymous) user count to idlerpg.net? jotun is ".
+ "interested in knowing how many people play his game :^) [yes]: ";
+ chomp($temp=<STDIN>);
+ $temp||="yes";
+ $temp=lc($temp);
+} until ($temp eq "yes" || $temp eq "no");
+
+if ($temp eq "yes") {
+ print "Sending...\n";
+ my $sock = IO::Socket::INET->new(PeerAddr=>"jotun.ultrazone.org:80");
+ if ($sock) {
+ print $sock "GET /g7/count.php?converted=".scalar(keys(%rps)).
+ " HTTP/1.1\r\n".
+ "Host: jotun.ultrazone.org:80\r\n\r\n";
+ 1 while <$sock>;
+ }
+ print "\nDone! Thanks a million! Enjoy Idle RPG. :^)\n";
+}
+else {
+ print "\nI'm setting your chance of evil HoG to 100%, then. Just kidding. ".
+ "Thanks anyway.\n";
+}
+
+sub loaddb { # load the players database
+ open(RPS,shift(@_)) or die("loaddb() failed: $!");
+ while (my $l=<RPS>) {
+ chomp $l;
+ next if $l =~ /^#/; # skip comments
+ my @i = split("\t",$l);
+ print Dumper @i if @i != 28;
+ die("Anomaly in loaddb(); line $. of database has wrong fields (".
+ scalar(@i).")") if @i != 28;
+ ($rps{$i[0]}{pass},
+ $rps{$i[0]}{level},
+ $rps{$i[0]}{class},
+ $rps{$i[0]}{next},
+ $rps{$i[0]}{nick},
+ $rps{$i[0]}{userhost},
+ $rps{$i[0]}{online},
+ $rps{$i[0]}{idled},
+ $rps{$i[0]}{pen_mesg},
+ $rps{$i[0]}{pen_nick},
+ $rps{$i[0]}{pen_part},
+ $rps{$i[0]}{pen_kick},
+ $rps{$i[0]}{pen_quit},
+ $rps{$i[0]}{pen_quest},
+ $rps{$i[0]}{pen_logout},
+ $rps{$i[0]}{created},
+ $rps{$i[0]}{lastlogin},
+ $rps{$i[0]}{item}{amulet},
+ $rps{$i[0]}{item}{charm},
+ $rps{$i[0]}{item}{helm},
+ $rps{$i[0]}{item}{"pair of boots"},
+ $rps{$i[0]}{item}{"pair of gloves"},
+ $rps{$i[0]}{item}{ring},
+ $rps{$i[0]}{item}{"set of leggings"},
+ $rps{$i[0]}{item}{shield},
+ $rps{$i[0]}{item}{tunic},
+ $rps{$i[0]}{item}{weapon}) = (@i[1..$#i]);
+ }
+ close RPS;
+}
--
2.43.0