334 Commits
Author SHA1 Message Date
Auto Bot 7079e203a8 Patched in whois support, for use with voicenonbots.pm 2011-04-23 11:49:50 +04:00
Matthew Barksdale 727062b14b Merge branch 'indev' of github.com:Xelhua/Auto into indev 2011-04-23 01:39:19 -04:00
Matthew Barksdale df31622f82 What is this I don't even.. 2011-04-23 01:39:11 -04:00
Elijah Perrault 76d2c03281 Werewolf 1.07: Various improvements. 2011-04-22 15:50:08 -06:00
Elijah Perrault 303e03f4ee Merge branch 'indev' of github.com:Xelhua/Auto into indev 2011-04-22 02:25:16 -06:00
Elijah Perrault 99bb0721ba Fixing Matt's fails. 2011-04-22 02:25:00 -06:00
Matthew Barksdale 6f9e6f0d5d Apparently these aren't needed 2011-04-21 23:27:30 -04:00
Matthew Barksdale ccab5e9ab9 Fixed a bug with MODE parsing 2011-04-21 23:24:40 -04:00
Elijah Perrault 03c1616364 Maybe I should include the actual changes... 2011-04-21 21:00:32 -06:00
Elijah Perrault 193461abf4 Updated Core::IRC::Users to be more efficient. 2011-04-21 21:00:13 -06:00
Elijah Perrault f1a9b91a30 Oops. 2011-04-21 20:58:48 -06:00
Elijah Perrault f3ad8e0e38 Use M::Werewolf, not ourselves. 2011-04-21 20:57:36 -06:00
Elijah Perrault 81ff64ba4f Slight errors. 2011-04-21 20:43:24 -06:00
Elijah Perrault 33b50a651a Added a WerewolfAdmin module for administering the Werewolf IRC game. 2011-04-21 20:39:55 -06:00
Elijah Perrault fdfc249ba8 Updated. 2011-04-21 20:39:21 -06:00
Elijah Perrault f68646d155 Small bug fix. 2011-04-21 18:51:23 -06:00
Elijah Perrault 6357c54574 Various other state bugs. 2011-04-21 15:48:26 -06:00
Elijah Perrault a8ea3f0e64 Fixed significant state mismatched data bugs. 2011-04-21 14:08:47 -06:00
Elijah Perrault 3fdf7dcaf5 What is this I don't even... 2011-04-21 14:02:34 -06:00
Elijah Perrault 105e83699d Added API::IRC::ison for checking if a user is on a channel. 2011-04-21 02:08:37 -06:00
Elijah Perrault 338551b44c Werewolf: Fixed a bug in harlot staying home. 2011-04-20 22:18:56 -06:00
Elijah Perrault 412261f478 Werewolf: Various bug fixes. 2011-04-20 21:36:11 -06:00
Elijah Perrault 988e93a6f1 Lets try this... 2011-04-20 21:27:46 -06:00
Elijah Perrault 6c4ff75a03 Here as well. 2011-04-20 20:56:21 -06:00
Elijah Perrault 362310b863 Regex is a bad idea for this. 2011-04-20 20:56:02 -06:00
Elijah Perrault a2002882d6 Oops. 2011-04-20 20:48:04 -06:00
Elijah Perrault 3ebe82ec28 Werewolf 1.06: Fixed an annoyance and added traitor transformation. 2011-04-20 20:44:59 -06:00
Elijah Perrault 42faabeef5 Updated. 2011-04-20 20:37:49 -06:00
Elijah Perrault 21fb5d4974 Commands now work with prefixes even in PM. 2011-04-20 20:37:31 -06:00
Elijah Perrault 8147e9e32a We're alpha11. 2011-04-20 20:25:04 -06:00
Elijah Perrault 0864f549d1 Ping: Determines end by numeric 315 instead of a 3-second timer now. 2011-04-20 20:20:58 -06:00
Elijah Perrault ba5de67e4a Werewolf: Fixed a GUARD issue and made it possible to VISIT yourself. 2011-04-19 20:23:37 -06:00
Elijah Perrault 3bd8e9369d Possibly fixed a rare fatal error. 2011-04-19 11:09:19 -06:00
Elijah Perrault e33fd1df8d Werewolf: Rewrote WAIT to be more decent. 2011-04-19 02:04:31 -06:00
Elijah Perrault 3ef78078c4 Werewolf: Wounded villagers are now excluded from winning villager count. 2011-04-18 17:35:36 -06:00
Elijah Perrault a1beabe76a Werewolf: Bold lynched nick. 2011-04-18 16:18:31 -06:00
Elijah Perrault f12b7ef527 Werewolf: Dynamic lynch and no victim messages. 2011-04-18 16:11:19 -06:00
Elijah Perrault ed56d53f1e Werewolf 1.05: Added WAIT command. 2011-04-18 15:35:23 -06:00
Elijah Perrault e590c0dee3 Werewolf: Improved STATS to be smart. 2011-04-18 14:23:58 -06:00
Elijah Perrault 9fca160de5 Drunks = villagers. 2011-04-16 23:40:11 -06:00
Elijah Perrault 28e29f2dba *sigh* 2011-04-16 22:11:32 -06:00
Elijah Perrault c30f300b24 Removed the "villager gunner" role. 2011-04-16 22:05:05 -06:00
Elijah Perrault 0d9a714c4a Oops. 2011-04-16 21:55:03 -06:00
Elijah Perrault 87ff93945f Fixed slight issue. 2011-04-16 21:43:50 -06:00
Elijah Perrault c13a4e2ffe Werewolf 1.04: Added village drunks and fixed other issues. 2011-04-16 21:39:01 -06:00
Elijah Perrault 42fcac5cc0 Err... 2011-04-16 19:38:28 -06:00
Elijah Perrault 01a432f023 Updated. 2011-04-16 19:14:57 -06:00
Elijah Perrault a47211763c Fixed various annoyances in Werewolf. 2011-04-16 19:13:50 -06:00
Elijah Perrault 8cddc69209 Been writing too much Python today. 2011-04-16 02:14:18 -06:00
Elijah Perrault b6eb0c17cc Whoops. 2011-04-16 02:09:49 -06:00
Elijah Perrault 38b3e4c3d8 Werewolf: Fixed a nasty lynch nick exploit. 2011-04-16 02:08:15 -06:00
Elijah Perrault 503a7ed990 Fixed spelling failures. 2011-04-15 22:40:37 -06:00
Elijah Perrault 579485776d Moved bolds a bit. 2011-04-15 22:19:27 -06:00
Elijah Perrault f5db549052 Improvements. 2011-04-15 18:06:15 -06:00
Elijah Perrault 72006a8e7e Fixed an issue in HELP. 2011-04-14 19:26:48 -06:00
Elijah Perrault 2ca0885741 Added a Ping module. 2011-04-14 18:43:48 -06:00
Elijah Perrault 6c6b8604bc Merge branch 'indev' of github.com:Xelhua/Auto into indev 2011-04-14 18:37:27 -06:00
Elijah Perrault da28c54652 Moved Werewolf back to stable. 2011-04-14 18:32:08 -06:00
Matthew Barksdale f0b49acbd0 Added cleaning up inconsistencies in modules to TODO 2011-04-14 03:53:19 -04:00
Matthew Barksdale 58447eb40a Added more French translations 2011-04-14 03:41:40 -04:00
Matthew Barksdale 363a724ed3 Added french help translation 2011-04-14 03:34:27 -04:00
Matthew Barksdale a122977644 Added deoper subroutine to deoper Auto on a server 2011-04-14 03:27:58 -04:00
Elijah Perrault 51f30e6346 Updated. 2011-04-13 20:34:05 -06:00
Elijah Perrault 82c0201c34 Updated for alpha10 release. 2011-04-13 20:32:42 -06:00
Elijah Perrault 3da9a98feb Updated. 2011-04-13 20:31:35 -06:00
Elijah Perrault ee1bf65766 Merge branch 'indev' of github.com:Xelhua/Auto into indev 2011-04-13 20:30:56 -06:00
Elijah Perrault 69927a21de Moving Werewolf to unstable/ for exclusion from alpha10 security release. 2011-04-13 20:25:14 -06:00
Alyx bb10d54844 Fixed easily exploitable 0day involving wide characters. Slightly surprised no one has triggered this yet, as exploitation involves nothing more than having Auto send a >8-byte character (, "𝄞"), via doing something like using LinkTitle.pm and putting the character into the <title> field.. This is a MAJOR security exploiit, and any user using a module where Auto would echo user-defined data should update immediately. 2011-04-13 19:58:25 -05:00
Elijah Perrault 1adcd0323b Werewolf: Fixed a bug causing double lynches occasionally. 2011-04-13 14:45:06 -06:00
Elijah Perrault 743bee7424 Fixes...? 2011-04-12 23:37:19 -06:00
Elijah Perrault 56b55d8370 More. 2011-04-12 23:20:00 -06:00
Elijah Perrault 8ec0a389d5 Bug fixes. 2011-04-12 23:19:28 -06:00
Elijah Perrault a9d6e3482b More cleanup. 2011-04-12 22:05:16 -06:00
Elijah Perrault ae9401bf7d Cleanup. 2011-04-12 21:57:47 -06:00
Elijah Perrault c818d13e04 wolves were -> wolf was. 2011-04-12 19:14:09 -06:00
Elijah Perrault cf6a99e170 * Werewolf: One bug fix and multiple bullets. 2011-04-12 14:32:21 -06:00
Elijah Perrault 516d11a5f7 Fixing fails. 2011-04-11 23:03:24 -06:00
Elijah Perrault dc96422598 Use a comma here. 2011-04-11 21:38:13 -06:00
Elijah Perrault e525af97a7 Switching to .14. 2011-04-11 18:20:09 -06:00
Elijah Perrault 60e9bca86d Bug fixes. 2011-04-11 18:19:35 -06:00
Elijah Perrault 8b3f287a49 Check if we should end the nighttime everytime someone dies. 2011-04-11 15:54:02 -06:00
Elijah Perrault da15ed72e8 Delete warned var here. 2011-04-11 14:40:19 -06:00
Elijah Perrault 76e903bb87 Use nicks instead. 2011-04-11 14:37:07 -06:00
Elijah Perrault 36b3761977 Werewolf: Fixed timeout bug. 2011-04-11 14:22:59 -06:00
Elijah Perrault a6da576144 Added Werewolf to module list. 2011-04-10 22:58:40 -06:00
Elijah Perrault a2975d4859 Werewolf: Fixed various warnings. 2011-04-10 22:48:09 -06:00
Elijah Perrault a328fc45cd Eitan Adler added to credits. 2011-04-10 21:35:17 -06:00
Elijah Perrault 38015434e1 Werewolf: Handful of bugs fixed, timeouts rewritten, wolf assignment rewritten. (see ROLES:Werewolf) 2011-04-10 21:34:20 -06:00
Elijah Perrault fe353984c2 Reverting all changes made by Eitan. 2011-04-10 19:25:12 -06:00
Elijah Perrault d31b16200e Werewolf: Fixed a slight fail in the new constants. 2011-04-10 19:21:30 -06:00
Eitan 9a526e1427 Werewolf: Use constants for maximum/gun player counts. 2011-04-10 19:07:38 -06:00
Elijah Perrault 8ddd4f5bae Werewolf: Fixed an annoyance in VOTES. 2011-04-10 18:59:57 -06:00
Elijah Perrault 1ef6814e9b Werewolf: Fixed another round of bugs. 2011-04-10 16:20:52 -06:00
Elijah Perrault 37030d7a55 Werewolf: Fixed a grammatical error. Thanks TAD! 2011-04-10 14:55:06 -06:00
Elijah Perrault 94db7280ff Werewolf: Fixed a bug that occasionally caused a person to get wolf twice in the same game. 2011-04-10 14:51:28 -06:00
Elijah Perrault 50f577470e Werewolf: Fixed a typo that broke the gun on occasion. 2011-04-10 12:18:26 -06:00
Elijah Perrault 6dd9ab5322 Fixed a minor retract bug in Werewolf. 2011-04-09 19:36:46 -06:00
Elijah Perrault 1e45c53d38 Fixed two major bugs in Werewolf that messed up game play. 2011-04-09 19:33:01 -06:00
Elijah Perrault 07d9c19b53 Fixed several bugs and changed around JOIN/START/BEGIN in Werewolf. 2011-04-09 18:06:02 -06:00
Elijah Perrault a79e6f3801 Guess we should note this here. 2011-04-09 14:46:05 -06:00
Elijah Perrault 1bcc849083 Fixed parsing of host masks with / in them. (I'm looking at you, freenode.) 2011-04-09 14:44:45 -06:00
Elijah Perrault 31428c8089 End the game if there's no more players, at all. 2011-04-07 15:56:56 -06:00
Elijah Perrault 8f58cb3c9f Werewolf: Fixed a leave before game begin bug. 2011-04-07 15:45:02 -06:00
Elijah Perrault bc287589bb Aliases now work in PM's to the bot too. 2011-04-07 14:54:30 -06:00
Elijah Perrault de3e914e3d Added an epic, Werewolf module. 2011-04-07 14:37:40 -06:00
Elijah Perrault e868892f51 Made slog() saner. 2011-04-04 15:31:30 -06:00
Elijah Perrault ce8ef76363 Remove unstable/ for now. 2011-04-04 15:27:41 -06:00
Elijah Perrault 06f22be92b Removing package name in mod_init calls. 2011-04-04 15:26:37 -06:00
Elijah Perrault d12c139829 Syntax for mod_init() changed. Package name is no longer required. :) 2011-04-04 15:23:03 -06:00
Elijah Perrault 3a8c2f31ba CSV has never worked, does not work, and will never work, pointless code is pointless. Removed. Did some misc. cleanup and don't import locale, we don't use it at all. 2011-03-30 22:10:52 -06:00
Elijah Perrault 051c189fe8 Oopsies. 2011-03-30 21:54:09 -06:00
Elijah Perrault 6035a0fdb5 Use bloody ucfirst, that's what it's there for. 2011-03-30 21:53:25 -06:00
Elijah Perrault 6539bd5fed Updated TODO. 2011-03-28 20:16:33 -06:00
Noah Ridley 8780cf5b93 Added German translations for EightBall, Eval, FML and Greet. 2011-03-26 22:43:07 -06:00
Noah Ridley a357eab962 Added German translations for Dictionary. 2011-03-26 20:05:58 -06:00
Noah Ridley e2038ed983 Added German translations for Bitly and Calc. 2011-03-26 19:34:10 -06:00
Noah Ridley 2469d636f5 Fixed a slight spelling error. 2011-03-26 19:31:23 -06:00
Elijah Perrault 176f861d2c Added nridley to credits. 2011-03-26 19:26:02 -06:00
Noah Ridley 68e9f59267 Added German translation to AUR. 2011-03-26 19:25:06 -06:00
Elijah Perrault 48864ee9fb We're alpha10. 2011-03-24 14:51:28 -06:00
Elijah Perrault e833309c4e Fixed a typo. 2011-03-24 14:19:53 -06:00
Elijah Perrault 3c81f0587a Updated for alpha9 release. 2011-03-24 14:18:18 -06:00
Elijah Perrault 5366855f96 Fixed an exploit in QDB RAND. 2011-03-24 14:15:28 -06:00
Elijah Perrault caf9b36b8c Updated for new installation guide. 2011-03-21 23:33:32 -06:00
Elijah Perrault 789cec8f80 UNO: Fixed a formatting issue in duration. 2011-03-21 21:21:20 -06:00
Elijah Perrault ed72b5e444 alpha9. 2011-03-21 21:20:40 -06:00
Elijah Perrault 3cfe22e5c1 More tabs = gone. 2011-03-21 14:20:19 -06:00
Elijah Perrault ea775d4c98 More tab removal. 2011-03-21 14:18:57 -06:00
Elijah Perrault 153084f808 Removing tabs. 2011-03-21 14:17:21 -06:00
Elijah Perrault 637db6bae4 var/* too. 2011-03-21 14:16:14 -06:00
Elijah Perrault 7f4ea8d196 Added a (not so thoroughly tested) Batch file for management of Auto. 2011-03-21 10:03:48 -06:00
Elijah Perrault 8ee16eb39b Add *.db to ignore. 2011-03-21 09:57:59 -06:00
Elijah Perrault 6813a009df Updated for alpha8 release. 2011-03-20 21:38:09 -06:00
Elijah Perrault 1d6436b59b With buildmod fixed, support for custom PREFIX installs (including global installs) is complete. 2011-03-20 21:36:49 -06:00
Elijah Perrault 0e781dde9d Fixed buildmod. 2011-03-20 21:35:11 -06:00
Elijah Perrault 4021eabcf5 Added fastest/slowest game, most cards and most players records to UNO. 2011-03-20 21:34:51 -06:00
Elijah Perrault 79db0a2687 Fixed a bug in UNO that allowed users to join more than once. 2011-03-20 17:15:27 -06:00
Elijah Perrault 05e49c0ba1 Added optional uno:english option. See documentation for UNO. 2011-03-20 17:07:52 -06:00
Elijah Perrault 0cb486191f Added uno:msg to synopsis. 2011-03-20 16:50:41 -06:00
Elijah Perrault 5bbbe224d3 Lets actually commit the changes. 2011-03-20 16:39:01 -06:00
Elijah Perrault d0eeb58c72 UNO has a new config option, uno:msg, for setting what method the bot uses for private messages. 2011-03-20 16:37:40 -06:00
Elijah Perrault 168266696a Added command aliasing. 2011-03-20 15:23:28 -06:00
Elijah Perrault 703f2c2ec8 Moved botinfo to State::IRC. 2011-03-20 13:40:41 -06:00
Elijah Perrault c999bd1372 Bumping version to 2.00d. 2011-03-20 13:16:52 -06:00
Elijah Perrault be9932498b Cloned UNO, to add an AI to it over time. 2011-03-20 13:15:49 -06:00
Elijah Perrault e033b76a6c Since Perl isn't so nice as to do this for us all the time, we'll throw it in. 2011-03-20 09:16:51 -06:00
Elijah Perrault 0315a1f121 Added hook on_selfkick for when we are kicked from a channel. 2011-03-19 23:12:54 -06:00
Elijah Perrault 669561c8a4 Removed some hard tabs. 2011-03-19 23:03:15 -06:00
Elijah Perrault 3e1e2e98be Large amounts of code cleanup. 2011-03-19 22:46:45 -06:00
Elijah Perrault f2deae219d Started State::IRC, and moved chanusers to it. 2011-03-18 14:34:02 -06:00
Elijah Perrault ab2d404f20 Removing more return 0's. 2011-03-18 14:06:22 -06:00
Elijah Perrault 8a8166bdb8 Removing return 0's as it's improper. 2011-03-18 14:05:10 -06:00
Elijah Perrault 374b04fddc Removing hard tabs. 2011-03-18 13:55:50 -06:00
Elijah Perrault 502cda97ed Cleanup. 2011-03-18 13:52:50 -06:00
Elijah Perrault 908dc13159 Start these out as 0, stopping a warning. 2011-03-18 01:31:20 -06:00
Elijah Perrault 1eff0e95e9 Bumping version. 2011-03-18 01:11:48 -06:00
Elijah Perrault b52b488165 UNO now keeps game duration and cards played count. 2011-03-18 01:09:53 -06:00
Elijah Perrault 1bbcc6feec Somewhat early spring cleaning! 2011-03-17 23:28:57 -06:00
Elijah Perrault a153045bc3 Cleaning up. 2011-03-17 22:50:14 -06:00
Elijah Perrault 9a61c75772 Updated. 2011-03-17 21:26:45 -06:00
Elijah Perrault 43928f70dc Updated list. 2011-03-17 21:24:54 -06:00
Elijah Perrault 9c8687da1c Added a LOLCAT module for translating English to LOLCAT. 2011-03-17 21:23:45 -06:00
Elijah Perrault 61fe399ac6 Rewrote EightBall to be nicer. 2011-03-17 21:00:50 -06:00
Elijah Perrault e2afe403c0 Fixing POD. 2011-03-17 13:33:33 -06:00
Elijah Perrault 0dc4f7a2b7 Bumping versions. 2011-03-17 13:32:02 -06:00
Elijah Perrault dbdb9e0d67 alpha8 support. 2011-03-17 13:31:12 -06:00
Elijah Perrault 6b09c4d818 Fixed a bug in LinkTitle that caused multi-line <title>'s to display wrong. 2011-03-17 13:28:12 -06:00
Elijah Perrault f75618e5ec This was in the wrong spot... 2011-03-16 23:02:53 -06:00
Elijah Perrault f19838091c Added wizard, for creating local Auto config directories. 2011-03-16 23:01:42 -06:00
Elijah Perrault 25a0ec8081 Made Auto respond properly to PRIVMSGs received before connection. 2011-03-16 18:38:49 -06:00
Elijah Perrault 9b9997a24d Added backgrounds to cards for those that have odd clients. 2011-03-14 23:32:02 -06:00
Elijah Perrault 618cc6cccb Fixed an exploit in QDB that allowed users to use services fantasy commands with the bot's account. 2011-03-14 21:56:29 -06:00
Elijah Perrault ddf2e8bdea Cleanup. 2011-03-14 18:58:35 -06:00
Elijah Perrault 992bc5affb Fixing documentation, syntax, etc. 2011-03-14 18:55:08 -06:00
Matthew Barksdale ca0545b000 Kill $man with fire 2011-03-14 20:52:37 -04:00
Matthew Barksdale ebf0a78cce Updated. 2011-03-14 20:40:05 -04:00
Matthew Barksdale 344ce60f00 Added a module to get information on packages in AUR. 2011-03-14 20:38:22 -04:00
Elijah Perrault e2d26e3982 Now works with custom PREFIX installs. 2011-03-12 22:21:44 -07:00
Elijah Perrault 98736ebac6 We're alpha8. 2011-03-11 22:22:53 -07:00
Elijah Perrault 59d5c36cba Added bin:mod, and module loading now works as desired. 2011-03-11 22:00:51 -07:00
Elijah Perrault a02a3a8728 Install modules too. 2011-03-11 22:00:32 -07:00
Elijah Perrault 8e1ce1476e auto.pid saves to the correct location and CertFP works. 2011-03-11 21:53:04 -07:00
Elijah Perrault 881fc0d93d Logging now works with custom PREFIX installs. \o/ 2011-03-11 21:41:53 -07:00
Elijah Perrault 580770c5b8 Now installing lang/ properly, and config+language files are pulled from the current working directory. 2011-03-11 21:39:50 -07:00
Elijah Perrault 6033904d0d bin:lng, and moved some stuff to the correct locations. 2011-03-11 21:32:24 -07:00
Elijah Perrault c1960f5837 New bin path system, partially finished. 2011-03-11 21:26:55 -07:00
Elijah Perrault 9bd3e5227b Copy example.conf to DISTDIR/ for later wizard installs. 2011-03-11 19:55:17 -07:00
Elijah Perrault 3efed8bad4 Move this to scripts/ until we decide to trash it. 2011-03-08 17:30:26 -07:00
Elijah Perrault 7342c70639 This is more desirable. 2011-03-07 21:01:31 -07:00
Elijah Perrault d0652138a1 Include this with Auto, for the sake of simplicity. 2011-03-07 20:57:30 -07:00
Elijah Perrault 0480810e59 Improved Lib::Install as well. 2011-03-07 20:46:43 -07:00
Elijah Perrault 9f223b5b92 Merge branch 'indev' of github.com:Xelhua/Auto into indev 2011-03-07 20:44:56 -07:00
Elijah Perrault 2836ebc6a3 Heavily improved ./install. 2011-03-07 20:44:30 -07:00
Matthew Barksdale 30c9178c4e Replaced some useless double quotes with single 2011-03-07 17:18:54 -05:00
Elijah Perrault 68c4ca7b4a Fixed an issue in Git snapshots. 2011-03-06 20:46:43 -07:00
Elijah Perrault 9f3a8624c9 /me slaps matthew 2011-03-06 19:48:24 -07:00
Elijah Perrault 11ea707bbe Updated. 2011-03-06 19:45:41 -07:00
Elijah Perrault 506921214d Updated for alpha7. 2011-03-06 19:40:20 -07:00
Elijah Perrault 9de77699f9 Fixed a bug in UNO where rehashing during a game caused a crash. 2011-03-05 16:39:49 -07:00
Matthew Barksdale f0807a8306 And sasl_timeout, else we're going to get an error 2011-03-05 15:54:02 -05:00
Matthew Barksdale 3ce0003c9e We should really check for password too here... 2011-03-05 15:52:11 -05:00
Matthew Barksdale 51d8bb69dd Fixed some spacing issues 2011-03-05 15:03:42 -05:00
Matthew Barksdale c3ac079e14 Fixed the POD for EightBall to follow the new CoC 2011-03-05 14:51:00 -05:00
Matthew Barksdale ad3340d82a Wth? 2011-03-05 14:46:54 -05:00
Matthew Barksdale 978a1585c8 Fix the POD for HelloChan to follow the new CoC 2011-03-05 14:45:43 -05:00
Matthew Barksdale 4337f29d0a Added a subroutine to access the OPER command, I'm eventually going to build upon this to be a full API for oper commands 2011-03-05 14:40:39 -05:00
Matthew Barksdale a587bab1c9 uhm... what? 2011-03-05 00:10:08 -05:00
Matthew Barksdale 1b13f4c39b Fixed the Oper module to actually work correctly when it's really not opered. 2011-03-05 00:09:27 -05:00
Elijah Perrault e61fdee14c Proto::IRC::umodes renamed to Proto::IRC::botinfo{svr}{modes}. 2011-03-04 21:54:12 -07:00
Elijah Perrault 9b0e692a8f Fixed a bug where incoming PART's from ourselves were not parsed. 2011-03-04 21:48:21 -07:00
Elijah Perrault 70723dfe68 Add a =cut. 2011-03-04 21:13:13 -07:00
Elijah Perrault 10fbddd2a6 Our usermodes are now tracked in Proto::IRC::umodes. 2011-03-04 20:45:31 -07:00
Elijah Perrault 963f55cc01 Added events on_cmode and on_umode. 2011-03-04 20:34:04 -07:00
Elijah Perrault 123357c448 Added event on_myinfo for RPL_MYINFO (numeric 004). 2011-03-04 20:14:09 -07:00
Matthew Barksdale 0b6ed4c0cc Fixed a few bugs 2011-03-04 21:28:32 -05:00
Matthew Barksdale 004c89f416 Added a module allowing you to oper up your bot, this will eventually be expanded upon. In addition, this allows you to call M::Oper::is_opered(server) to check if your Auto instance is an oper on the specified server. 2011-03-04 21:24:29 -05:00
Elijah Perrault d4ff35a5f9 Raw hooks now take hook names and support multiple hooks. This changes rchook_add and rchook_del. 2011-03-04 19:14:18 -07:00
Elijah Perrault f4448302e2 Vim modelines must be at the bottom of files. Modules updated. 2011-03-04 15:49:43 -07:00
Elijah Perrault 348ee6dc79 Forgot the quotes. 2011-03-03 18:54:51 -07:00
Elijah Perrault 604097ee1c Eh, might as well add xsm, to shut Perl::Critic up. 2011-03-03 15:58:49 -07:00
Elijah Perrault 3a7ffb24ee Fixed some Perl::Critic violations. 2011-03-03 15:55:55 -07:00
Elijah Perrault 60edbba15d Rest of renaming. 2011-03-03 15:38:58 -07:00
Elijah Perrault 12ed97b398 Renamed Lib::Users to Core::IRC::Users. 2011-03-03 15:38:11 -07:00
Elijah Perrault bd6571bbf5 Added Lib::User, for network-wide user tracking. This brings many new possibilities to modules, including an account system. 2011-03-03 15:34:41 -07:00
Elijah Perrault c15c945262 Added hook on_namesreply. 2011-03-03 15:19:15 -07:00
Elijah Perrault 5f1bf3785c Parse -nuc as well. 2011-03-02 22:17:18 -07:00
Elijah Perrault 45bb7e668c Fixed a bug where a CAP entry for a network was not recreated on a reconnect. 2011-03-02 22:05:13 -07:00
Elijah Perrault c268f27308 Include this as well. 2011-03-02 22:02:46 -07:00
Elijah Perrault 62551dc6c9 Added hook on_disconnect. 2011-03-02 22:02:24 -07:00
Elijah Perrault 12356984fc Don't surpass 80 characters. 2011-03-02 21:39:48 -07:00
Elijah Perrault 223cdd7860 Updated. 2011-03-02 20:28:30 -07:00
Elijah Perrault 9e8018c98e Added various options to bin/auto, including support for multiple config files. See bin/auto -h for details. 2011-03-02 20:26:34 -07:00
Elijah Perrault 0e708c5ee3 Lots of cleanup. 2011-03-02 19:08:00 -07:00
Elijah Perrault a66d6993cd Matthew failed. 2011-03-02 15:46:13 -07:00
Matthew Barksdale 328eac87b0 Merge branch 'indev' of github.com:Xelhua/Auto into indev 2011-03-02 17:39:58 -05:00
Matthew Barksdale 0e46850a65 Changed on_nick, on_quit, on_part, and on_kick source hashrefs to include server, removing svr. 2011-03-02 17:37:27 -05:00
Elijah Perrault 5da0eb0f6e Fixed all modules. 2011-03-02 15:05:46 -07:00
Elijah Perrault 8c037a9a35 Bumped minimum API version to 3.0.0a7. 2011-03-02 15:04:42 -07:00
Elijah Perrault 4e0384d645 Added UNO to this list. 2011-03-01 22:08:58 -07:00
Elijah Perrault 117ef08c23 Forgot to commit this... 2011-02-28 20:26:46 -07:00
Elijah Perrault e67b4b265c This undef is no longer needed. 2011-02-28 20:24:40 -07:00
Elijah Perrault 4dbfac1f5e We're alpha7. 2011-02-28 20:22:29 -07:00
Elijah Perrault 956cd12e5b Fixed the arguments on_whoreply passes. 2011-02-28 20:21:28 -07:00
Elijah Perrault af92eed006 Updated. 2011-02-27 21:40:59 -07:00
Elijah Perrault f904d3e991 Updated for alpha6 release. 2011-02-27 21:38:00 -07:00
Elijah Perrault f51e695a2a My last commit also included a bugfix regarding SASL timeout. 2011-02-27 21:36:06 -07:00
Elijah Perrault e65f5d6f0a Cleanup, CAP is now core and added hook on_capack. 2011-02-27 21:33:47 -07:00
Elijah Perrault b48e77a4b3 Trigger on_shutdown in the event of a fatal error. 2011-02-27 20:26:37 -07:00
Elijah Perrault bfa0baf51e Cleaned up socket creation heavily. 2011-02-27 20:23:56 -07:00
Elijah Perrault c5f8a31bd0 Fixed a bug with multi-prefix support. 2011-02-27 16:55:06 -07:00
Elijah Perrault 66cc08fd87 Use fpfmt here. 2011-02-27 16:18:38 -07:00
Elijah Perrault b0fc9065f5 Added fpfmt() to API::Std, and removed the %20's from Bin. 2011-02-27 16:17:40 -07:00
Elijah Perrault ec363be888 Replace spaces in the file path with %20. 2011-02-27 12:52:06 -07:00
Elijah Perrault eda22e02db Use quotes to satisfy Windows. 2011-02-27 12:50:27 -07:00
Elijah Perrault 8d5664c7ef Added an extra note. 2011-02-27 12:49:47 -07:00
Elijah Perrault 7e8ba692f7 Add a check for Solaris. 2011-02-26 23:49:57 -07:00
Elijah Perrault 3e418271c7 Some notes for when running on Windows. 2011-02-26 23:32:45 -07:00
Elijah Perrault c3b3c56322 Windows is now supported. 2011-02-26 23:16:32 -07:00
Elijah Perrault f7b5428c60 Auto::GR renamed to $Auto::VERGITREV. 2011-02-26 23:11:37 -07:00
Elijah Perrault ef75910c0e Invoke perl from command line instead. 2011-02-26 21:11:33 -07:00
Elijah Perrault 6d0efb08f7 Cleanup. 2011-02-26 21:07:43 -07:00
Elijah Perrault 3ca1685044 Needs more exit. 2011-02-26 20:09:40 -07:00
Elijah Perrault aa1302c1bb Cleaning up. 2011-02-26 20:08:15 -07:00
Elijah Perrault 14334122bc Cleaning up. 2011-02-26 19:54:50 -07:00
Elijah Perrault c88c8f66f3 Whoops. 2011-02-26 17:21:09 -07:00
Elijah Perrault 0ba0d8e030 A list of abbreviated with full name licenses, for future reference. 2011-02-26 17:02:09 -07:00
Elijah Perrault db3f388006 Fixed a few warnings. 2011-02-26 14:49:53 -07:00
Elijah Perrault 5b8568f811 Bumped minimum version for API to 3.0.0a6. 2011-02-26 14:36:43 -07:00
Elijah Perrault d33d47afd2 Cleaned up TOPIC parsing. 2011-02-26 14:27:57 -07:00
Elijah Perrault 5c517b8093 This has been removed. 2011-02-26 14:09:40 -07:00
Elijah Perrault 58063f147d New hook on_isupport, code cleanup, and now parsing numeric 004 (RPL_MYINFO). 2011-02-26 14:08:39 -07:00
Elijah Perrault 8f5da92a45 Updated list. 2011-02-25 23:16:30 -07:00
Elijah Perrault 88e8930aff Fixed a bug in TOP10. 2011-02-25 22:21:51 -07:00
Elijah Perrault 2e7ab78f7e Removed a comma. 2011-02-25 21:29:20 -07:00
Elijah Perrault a8b8256385 Added a BotStats module for returning statistics about the bot. 2011-02-25 21:26:40 -07:00
Elijah Perrault 501dd30a0b Now parsing numeric 396. 2011-02-25 20:48:45 -07:00
Elijah Perrault 8512ea129a * Added who() to API::IRC.
* Added hook on_whoreply.
* PRIVMSGs and NOTICEs that would cause a >512 bytes resulting message are now divided into multiple messages.
* Renamed botnick to botinfo.
2011-02-25 20:14:19 -07:00
Elijah Perrault 9c8200fb78 Updated. 2011-02-25 18:23:51 -07:00
Elijah Perrault d5378cca9f Continue renaming. 2011-02-25 18:22:13 -07:00
Elijah Perrault 06aaf41ef0 Continue renaming process. 2011-02-25 18:19:58 -07:00
Elijah Perrault 402dfade65 Merge branch 'indev' of github.com:Xelhua/Auto into indev 2011-02-25 18:16:22 -07:00
Elijah Perrault 217fdbd1e7 We're renaming Parser::IRC to Proto::IRC. 2011-02-25 18:15:57 -07:00
Elijah Perrault a895a77418 Sigh. Now, fix it. 2011-02-25 13:06:26 -07:00
Elijah Perrault 91185e5ec3 Now, fix it. 2011-02-25 13:06:16 -07:00
Elijah Perrault 989d52b7f7 Set et to true in modelines. 2011-02-25 13:02:59 -07:00
Elijah Perrault b25ec915b9 Can now be used in a channel and, now returns any errors that occur. 2011-02-23 15:02:17 -07:00
Elijah Perrault 064f1099e3 Added an Eval module for evaluating Perl code. 2011-02-23 14:43:19 -07:00
Elijah Perrault b7d6da07b0 Accept alpha6 modules. 2011-02-23 14:27:29 -07:00
Elijah Perrault f481f9d4e7 Whoops, this was for 3.0.0a6, not 3.0.0a5. 2011-02-23 14:25:24 -07:00
Elijah Perrault fdb4093ad6 Added 'any' option for uno:edition (see POD:INSTALL) and made edition update on rehash. 2011-02-23 11:55:11 -07:00
Elijah Perrault 0bbcdd7f4b Fix formatting. 2011-02-23 11:34:21 -07:00
Elijah Perrault 71056bc2ed Fixed a bug with wildcards and made red|green|blue|yellow valid colors. 2011-02-22 22:30:01 -07:00
Elijah Perrault 88cdde59ce Updated. 2011-02-22 22:16:46 -07:00
Elijah Perrault 910c1afb86 Added an UNO module for endless fun playing the UNO card game. Warning: Can be addicting. MAKE SURE TO READ THE DOCS. 2011-02-22 22:14:59 -07:00
Elijah Perrault 39ce9b2da4 Updated. 2011-02-22 21:19:15 -07:00
Elijah Perrault cae3f191a8 Initialize the on_part event. 2011-02-22 21:18:27 -07:00
Elijah Perrault 47605fd33e Remove any leading colons. 2011-02-22 11:10:11 -07:00
Elijah Perrault 4de600d91a Updated for 3.0.0a5. 2011-02-21 23:31:55 -07:00
Elijah Perrault 7902aba4c5 Bug fix: Fixed broken rehash. 2011-02-21 23:30:55 -07:00
Elijah Perrault f3f58c8f94 Updated. 2011-02-21 23:29:56 -07:00
Elijah Perrault c616931339 Try again. 2011-02-20 20:48:46 -07:00
Elijah Perrault 92c9a64793 Revert "Getting rid of tabs."
This reverts commit cc1c8fd5bc.
Failed.
2011-02-20 20:47:09 -07:00
Elijah Perrault cc1c8fd5bc Getting rid of tabs. 2011-02-20 20:46:10 -07:00
Elijah Perrault ad799a32a2 Ignore PRIVMSG's if they're from an invalid source. 2011-02-20 19:51:09 -07:00
Elijah Perrault 35f58bf5b7 Fixed an odd bug when viewing non-existent quotes. 2011-02-20 19:44:18 -07:00
Elijah Perrault 9ad245fc79 My bad. 2011-02-19 21:08:32 -07:00
Elijah Perrault f9cafa11e7 Fixed a small issue. 2011-02-19 21:06:18 -07:00
Elijah Perrault 6a7cf754cc Stupid Git. 2011-02-19 21:04:18 -07:00
Elijah Perrault 24ab4aaf9a Improved QDB. Also, You can now define how many results are returned by QDB SEARCH/MORE at a time with qdb_search_resnum in the config. 2011-02-19 21:02:31 -07:00
Elijah Perrault 9ff384866e Improved MORE. 2011-02-19 17:17:19 -07:00
Elijah Perrault 4eb157ad8e Filter regex characters. 2011-02-19 17:05:03 -07:00
Elijah Perrault bec120c70f Try this instead. 2011-02-19 16:59:28 -07:00
Elijah Perrault 8898e74341 Use case insensitivity. 2011-02-19 16:56:41 -07:00
Elijah Perrault 18a8752e28 Added SEARCH and MORE to QDB. 2011-02-19 16:54:21 -07:00
Elijah Perrault 27521072c5 Whoops. 2011-02-19 16:29:26 -07:00
Elijah Perrault 01cc71d564 Documentation updated. 2011-02-19 16:26:03 -07:00
Matthew Barksdale 634a68b5f2 Don't export println 2011-02-19 04:06:44 -05:00
Matthew Barksdale c330a59474 Replaced println with say 2011-02-19 04:04:04 -05:00
Matthew Barksdale be43449e74 Fixed a typo. 2011-02-19 04:02:57 -05:00
Matthew Barksdale 445b7e0db3 Revert "Replaced println with say."
This reverts commit 30d9e11f1f.
2011-02-19 04:02:16 -05:00
Matthew Barksdale 30d9e11f1f Replaced println with say. 2011-02-19 04:00:42 -05:00
Matthew Barksdale 66c4b3441a Updated. 2011-02-19 03:55:53 -05:00
Matthew Barksdale ba6f7dba40 Updated MODS - Mouse has been gone for a while, and DBI was introduced for the DB backend 2011-02-19 03:52:47 -05:00
Matthew Barksdale 5f74bb3171 Kill EMODS with fire 2011-02-19 03:49:11 -05:00
Matthew Barksdale 15f188edfb This is why you shouldn't code half asleep 2011-02-19 03:43:41 -05:00
Matthew Barksdale 6e0263bcd8 Fixed an issue with cjoin 2011-02-19 03:39:53 -05:00
Elijah Perrault 411e08fd1c Added core command MODLIST. 2011-02-18 23:49:27 -07:00
Elijah Perrault e93939d4cf Added command level 3 for logchan-only command. 2011-02-18 23:26:41 -07:00
Elijah Perrault 88d7799569 Updated for alpha5. 2011-02-18 15:13:33 -07:00
Elijah Perrault 234c8d1657 Use HTML::Entities to decode the entities in the response. 2011-02-18 15:07:46 -07:00
Elijah Perrault 11dae6b927 Added a LinkTitle module for getting the title of a web page posted in a channel. This is of little use, but meh. 2011-02-18 14:54:49 -07:00
Elijah Perrault 897ad85615 Allow alpha5 modules. 2011-02-18 14:36:19 -07:00
Elijah Perrault 96384f853a Updated. 2011-02-18 14:25:07 -07:00
Elijah Perrault c5e0853cb1 Updated for alpha4. 2011-02-17 22:40:43 -07:00
56 changed files with 8382 additions and 1433 deletions

No files matched your search

+4 -1
View File
@@ -1,3 +1,6 @@
*.conf auto.conf
build/* build/*
*.swp *.swp
autodoc/*
*.db
var/*
+11 -23
View File
@@ -7,41 +7,29 @@
3.0 3.0
The future of IRC bots is here! Xelhua gives to you, Auto 3.0, a new version of The future of IRC bots is here! Xelhua gives to you, Auto 3.0, a new version of
the popular Auto IRC bot. the popular Auto IRC bot.
In this alpha4 release, we have added: In this alpha11 release, we have added:
* MySQL support. * Ping: Speed improvements.
* PostgreSQL support. * An advanced IRC version of the popular party game Werewolf (AKA Mafia).
* A Greet module for greeting users on join. * Commands with prefixes now work in PM's too.
* IRC logchan functionality.
* Improved multilingual support.
* A ChanTopics module for advanced management of channel topics.
* buildmod now generates HTML and man(1) pages from a module's POD.
* server:ajoin now supports channel keys by spacing the name and key.
* A Dictionary module for looking up definitions of words.
* Heavily improved module API.
Bug fixes: Bug fixes:
* Commands getting Permission denied even with incorrect prefix. * Fixed significant state mismatched data bugs.
* Program not properly shutting down if all IRC connections close.
Incompatibilities: Incompatibilities:
* Database: Changed structure of the `qdb` table. Modify the configuration None
values in upgrade.pl then run it to upgrade the database.
* database:format is now required in the config.
* bantype is now required in the config.
We thank you for choosing Auto. Please remember that he is still in early We thank you for choosing Auto. Please remember that he is coming to late
development stages. But we hope we've piqued your interest, as Auto's upcoming development stages soon, and testers are needed! But we hope we've piqued
module repository will allow modules to be created by anyone and uploaded your interest, as Auto's upcoming module repository will allow modules to be
there for everyone to use. created by anyone and uploaded there for everyone to use.
Auto's goal is to create an efficient, stable and highly customizable IRC bot Auto's goal is to create an efficient, stable and highly customizable IRC bot
in Perl. To offer an alternative to other platforms. in Perl. To offer an alternative to other platforms.
Enjoy Auto 3.0.0 Alpha 4! Enjoy Auto 3.0.0 Alpha 11!
+2 -1
View File
@@ -38,7 +38,8 @@ Contributors - Non-developers who contribute to the project greatly.
3. HOW TO INSTALL 3. HOW TO INSTALL
Installation documentation is at: http://wiki.xelhua.org/index.php/Auto:Install Installation documentation is at:
http://wiki.xelhua.org/index.php/Auto:Installation_guide
4. HOW TO UPGRADE 4. HOW TO UPGRADE
+1 -1
View File
@@ -42,7 +42,7 @@ greatly.
## 3. HOW TO INSTALL ## 3. HOW TO INSTALL
Installation documentation can be found [here](http://wiki.xelhua.org/index.php/Auto:Install). Installation documentation can be found [here](http://wiki.xelhua.org/index.php/Auto:Installation_guide).
## 4. HOW TO UPGRADE ## 4. HOW TO UPGRADE
+3 -7
View File
@@ -5,8 +5,7 @@
# Written in sh because the user may not have Perl...to run Auto.... # Written in sh because the user may not have Perl...to run Auto....
PID=bin/auto.pid PID=bin/auto.pid
MODS="Mouse Class::Unload" MODS="Class::Unload DBI"
EMODS="MIME::Base64 XML::Simple"
if [ "$1" = "start" ] ; then if [ "$1" = "start" ] ; then
if [ -e $PID ]; then if [ -e $PID ]; then
@@ -47,11 +46,8 @@ elif [ "$1" = "status" ]; then
elif [ "$1" = "getmodules" ]; then elif [ "$1" = "getmodules" ]; then
cpan -i $MODS cpan -i $MODS
elif [ "$1" = "getextras" ]; then
cpan -i $EMODS
else else
echo "Usage: auto (start|stop|rehash|status|getmodules|getextras)" echo "Usage: auto (start|stop|rehash|status|getmodules)"
fi fi
# vim: set ai sw=4 ts=4: # vim: set ai et sw=4 ts=4:
+45
View File
@@ -0,0 +1,45 @@
:: auto.bat - Launcher for Microsoft Windows.
:: Copyright (C) 2010-2011 Xelhua Development Group, et al.
:: Released under the terms stated in doc/LICENSE.
:: Clone of `auto`, since Windows likes Batch, not sh.
@echo off
set pidfile=bin/auto.pid
if "%1" == "" goto errparams
if "%1" == "start" goto start
if "%1" == "status" goto status
else goto errparams
:errparams
echo.
echo Usage: auto.bat (start|status) [force]
:end
:start
echo.
if exist "%pidfile" (
if "%2" == "force" (
echo Starting Auto. . .
perl bin/auto
)
else (
echo Auto appears to be running already. Run `auto.bat start force` to start anyway.
)
)
else (
echo Starting Auto. . .
perl bin/auto
)
:end
:status
echo.
if exist "%pidfile" (
echo Status: Auto appears to be running.
)
else (
echo Status: Auto appears to not be running.
)
:end
+178 -138
View File
@@ -9,17 +9,56 @@ use strict;
use warnings; use warnings;
no feature qw(state); no feature qw(state);
use POSIX; use POSIX;
use locale;
use English qw(-no_match_vars); use English qw(-no_match_vars);
use Sys::Hostname; use Sys::Hostname;
use IO::Socket; use IO::Socket;
use IO::Select; use IO::Select;
use Getopt::Long;
use DBI; use DBI;
use Class::Unload; use Class::Unload;
use FindBin qw($Bin); use FindBin qw($Bin);
our $Bin = $Bin; ## no critic qw(NamingConventions::Capitalization Variables::ProhibitPackageVars) our $Bin = $Bin; ## no critic qw(NamingConventions::Capitalization Variables::ProhibitPackageVars)
our (%bin, $UPREFIX);
BEGIN { BEGIN {
unshift @INC, "$Bin/../lib"; $bin{cwd} = getcwd;
if (!-e "$Bin/../build/syswide") {
# Must be a custom PREFIX install.
$bin{etc} = "$bin{cwd}/etc";
$bin{var} = "$bin{cwd}/var";
if (!-e "$Bin/lib/Lib/Auto.pm") {
# Must be a system wide install.
$bin{lib} = "$Bin/../lib/autobot/3.0.0";
$bin{bld} = "$bin{lib}/build";
$bin{lng} = "$bin{lib}/lang";
$bin{mod} = "$bin{lib}/modules";
}
else {
# Or not.
$bin{lib} = "$Bin/../lib";
$bin{bld} = "$Bin/../build";
$bin{lng} = "$Bin/../lang";
$bin{mod} = "$Bin/../modules";
}
$UPREFIX = 1;
}
else {
# Must be a standard install.
$bin{etc} = "$Bin/../etc";
$bin{var} = "$Bin/../var";
$bin{lib} = "$Bin/../lib";
$bin{bld} = "$Bin/../build";
$bin{lng} = "$Bin/../lang";
$bin{mod} = "$Bin/../modules";
$UPREFIX = 0;
}
unshift @INC, $bin{lib};
if (-d "$Bin/../.git") {
open my $gitfh, '<', "$Bin/../.git/refs/heads/indev";
our $VERGITREV = substr readline $gitfh, 0, 7;
close $gitfh;
}
# Set version information. # Set version information.
use constant { ## no critic qw(ValuesAndExpressions::ProhibitConstantPragma) use constant { ## no critic qw(ValuesAndExpressions::ProhibitConstantPragma)
@@ -28,29 +67,30 @@ BEGIN {
SVER => 0, SVER => 0,
REV => 0, REV => 0,
RSTAGE => 'd', RSTAGE => 'd',
GR => substr `cat $Bin/../.git/refs/heads/indev`, 0, 7
}; };
} }
use Lib::Auto; use Lib::Auto;
use API::Std qw(conf_get err); use API::Std qw(conf_get err);
use API::Log qw(println alog dbug); use API::Log qw(alog dbug);
#use DB::Flatfile; #use DB::Flatfile;
use Parser::Config; use Parser::Config;
use Parser::Lang; use Parser::Lang;
use Parser::IRC; use Proto::IRC;
use State::IRC;
use Core::IRC; use Core::IRC;
use Core::IRC::Users;
use Core::Cmd; use Core::Cmd;
our $VERSION = 3.0.0; our $VERSION = 3.000000;
local $PROGRAM_NAME = 'auto'; local $PROGRAM_NAME = 'auto';
# Check for build files. # Check for build files.
if (!-e "$Bin/../build/os" or !-e "$Bin/../build/perl" or !-e "$Bin/../build/time" or !-e "$Bin/../build/ver") { if (!-e "$bin{bld}/os" or !-e "$bin{bld}/perl" or !-e "$bin{bld}/time" or !-e "$bin{bld}/ver") {
say 'Missing build file(s). Please build Auto before running it.' and exit; say 'Missing build file(s). Please build Auto before running it.' and exit;
} }
# Check build OS. # Check build OS.
open my $BFOS, '<', "$Bin/../build/os" or say 'Cannot start: Broken build.' and exit; open my $BFOS, '<', "$bin{bld}/os" or say 'Cannot start: Broken build.' and exit;
my @BFOS = <$BFOS>; my @BFOS = <$BFOS>;
close $BFOS or say 'Cannot start: Broken build.' and exit; close $BFOS or say 'Cannot start: Broken build.' and exit;
if ($BFOS[0] ne $OSNAME."\n") { if ($BFOS[0] ne $OSNAME."\n") {
@@ -60,14 +100,14 @@ undef @BFOS;
# Check build features. # Check build features.
our $ENFEAT; our $ENFEAT;
open my $BFFEAT, '<', "$Bin/../build/feat" or say 'Cannot start: Broken build.' and exit; open my $BFFEAT, '<', "$bin{bld}/feat" or say 'Cannot start: Broken build.' and exit;
my @BFFEAT = <$BFFEAT>; my @BFFEAT = <$BFFEAT>;
close $BFFEAT or say 'Cannot start: Broken build.' and exit; close $BFFEAT or say 'Cannot start: Broken build.' and exit;
$ENFEAT = substr $BFFEAT[0], 0, length($BFFEAT[0]) - 1; $ENFEAT = substr $BFFEAT[0], 0, length($BFFEAT[0]) - 1;
undef @BFFEAT; undef @BFFEAT;
# Check build Perl version. # Check build Perl version.
open my $BFPERL, '<', "$Bin/../build/perl" or say 'Cannot start: Broken build.' and exit; open my $BFPERL, '<', "$bin{bld}/perl" or say 'Cannot start: Broken build.' and exit;
my @BFPERL = <$BFPERL>; my @BFPERL = <$BFPERL>;
close $BFPERL or say 'Cannot start: Broken build.' and exit; close $BFPERL or say 'Cannot start: Broken build.' and exit;
if ($BFPERL[0] ne $]."\n") { if ($BFPERL[0] ne $]."\n") {
@@ -76,7 +116,7 @@ if ($BFPERL[0] ne $]."\n") {
undef @BFPERL; undef @BFPERL;
# Check build Auto version. # Check build Auto version.
open my $BFVER, '<', "$Bin/../build/ver" or say 'Cannot start: Broken build.' and exit; open my $BFVER, '<', "$bin{bld}/ver" or say 'Cannot start: Broken build.' and exit;
my @BFVER = <$BFVER>; my @BFVER = <$BFVER>;
close $BFVER or say 'Cannot start: Broken build.' and exit; close $BFVER or say 'Cannot start: Broken build.' and exit;
if ($BFVER[0] ne VER.q{.}.SVER.q{.}.REV.RSTAGE."\n") { if ($BFVER[0] ne VER.q{.}.SVER.q{.}.REV.RSTAGE."\n") {
@@ -84,6 +124,14 @@ if ($BFVER[0] ne VER.q{.}.SVER.q{.}.REV.RSTAGE."\n") {
} }
undef @BFVER; undef @BFVER;
# Check build path setup.
our $SYSWIDE;
open my $BFPATH, '<', "$bin{bld}/syswide" or say 'Cannot start: Broken build.' and exit;
my @BFPATH = <$BFPATH>;
close $BFPATH or say 'Cannot start: Broken build.' and exit;
if ($BFPATH[0] eq "1\n") { $SYSWIDE = 1 }
else { $SYSWIDE = 0 }
# Set signal handlers. # Set signal handlers.
local $SIG{TERM} = \&Lib::Auto::signal_term; local $SIG{TERM} = \&Lib::Auto::signal_term;
local $SIG{INT} = \&Lib::Auto::signal_int; local $SIG{INT} = \&Lib::Auto::signal_int;
@@ -94,6 +142,59 @@ API::Std::event_add('on_sigterm');
API::Std::event_add('on_sigint'); API::Std::event_add('on_sigint');
API::Std::event_add('on_sighup'); API::Std::event_add('on_sighup');
# Get arguments.
our ($DEBUG, $NUC);
my ($opt_help, $opt_version, $USECONFIG);
GetOptions(
'nuc' => \$NUC,
'config|c=s' => \$USECONFIG,
'h|help' => \$opt_help,
'debug|d' => \$DEBUG,
'version|v' => \$opt_version,
);
# If we were passed -h, print help.
if ($opt_help) {
print <<"HELP";
Usage: $PROGRAM_NAME [options]
--help, -h Prints this help.
--version, -v Prints the version of this Auto.
--debug, -d Runs Auto in debug mode. Debug mode will print out debug
messages, including IRC raw data, to screen. This will also
stop Auto from forking into the background.
--config=FILENAME, -c Uses etc/FILENAME for the configuration file.
HELP
exit 1;
}
# If we were passed -v, print version.
if ($opt_version) {
say q{};
say NAME.' version '.VER.', subversion '.SVER.', revision '.REV.' ('.VER.q{.}.SVER.q{.}.REV.RSTAGE.').';
print <<'VERINFO';
Copyright (C) 2010-2011, Xelhua Development Group. All rights reserved.
Auto is released under the licensing terms of the New (3-Clause) BSD License,
which may be found in doc/LICENSE.
For documentation, you might refer to README, doc/*, and the Xelhua Wiki at
http://wiki.xelhua.org. Documentation for modules is stored in Man Page and
HTML form in autodoc/.
For support, visit the Xelhua Forums at http://forums.xelhua.org, or drop by
the official IRC chatroom at irc.xelhua.org #xelhua. Please report bugs and
request new features at http://rm.xelhua.org.
VERINFO
exit 1;
}
undef $opt_help;
undef $opt_version;
# Print startup message. # Print startup message.
say <<'EOF'; say <<'EOF';
@@ -108,31 +209,23 @@ say '* '.NAME.' (version '.VER.q{.}.SVER.q{.}.REV.RSTAGE.') is starting up...';
our ($APID, %TIMERS); our ($APID, %TIMERS);
# Get arguments.
our $DEBUG = 0;
our $NUC = 0;
if (defined $ARGV[0]) {
foreach (@ARGV) {
given ($_) {
when ('-d') { $DEBUG = 1; }
when ('-nuc') { $NUC = 1; }
}
}
}
# Check for updates. # Check for updates.
Lib::Auto::checkver(); Lib::Auto::checkver();
# Include IPv6 if Auto was built for it. # Include IPv6 if Auto was built for it.
if ($ENFEAT =~ /ipv6/) { require IO::Socket::INET6; } if ($ENFEAT =~ /ipv6/) { require IO::Socket::INET6 }
# Include SSL if Auto was built for it. # Include SSL if Auto was built for it.
if ($ENFEAT =~ /ssl/) { require IO::Socket::SSL; } if ($ENFEAT =~ /ssl/) { require IO::Socket::SSL }
# Parse configuration file. # Parse configuration file.
say '* Parsing configuration file auto.conf...'; my $configfile = 'auto.conf';
our $CONF = Parser::Config->new('auto.conf') or err(1, 'Failed to parse configuration file!', 1); if ($USECONFIG) { $configfile = $USECONFIG }
say "* Parsing configuration file $configfile...";
our $CONF = Parser::Config->new($configfile) or err(1, 'Failed to parse configuration file!', 1);
our %SETTINGS = $CONF->parse or err(1, 'Failed to parse configuration file!', 1); our %SETTINGS = $CONF->parse or err(1, 'Failed to parse configuration file!', 1);
say ' Success'; say ' Success';
undef $configfile;
undef $USECONFIG;
if (conf_get('die')) { if (conf_get('die')) {
if ((conf_get('die'))[0][0] == 1) { if ((conf_get('die'))[0][0] == 1) {
@@ -171,25 +264,26 @@ our $DB;
given (lc((conf_get('database:format'))[0][0])) { given (lc((conf_get('database:format'))[0][0])) {
when ('sqlite') { when ('sqlite') {
# SQLite. # SQLite.
if ($ENFEAT !~ /sqlite/) { err(2, 'Auto not built with SQLite support. Aborting.', 1); } if ($ENFEAT !~ /sqlite/) { err(2, 'Auto not built with SQLite support. Aborting.', 1) }
if (!conf_get('database:filename')) { err(2, 'Missing required configuration value database:filename. Aborting.', 1); } if (!conf_get('database:filename')) { err(2, 'Missing required configuration value database:filename. Aborting.', 1) }
# Import DBD::SQLite. # Import DBD::SQLite.
require DBD::SQLite; require DBD::SQLite;
if (!-e "$Bin/../etc/".(conf_get('database:filename'))[0][0]) { if (!-e "$bin{etc}/".(conf_get('database:filename'))[0][0]) {
# Create <database:filename> if it's missing. # Create <database:filename> if it's missing.
system "touch $Bin/../etc/".(conf_get('database:filename'))[0][0]; open my $dbfh, '>', "$bin{etc}/".(conf_get('database:filename'))[0][0];
system "chmod a+x $Bin/../etc/".(conf_get('database:filename'))[0][0]; close $dbfh;
chmod 0755, "$bin{etc}/".(conf_get('database:filename'))[0][0];
} }
# Connect to database. # Connect to database.
$DB = DBI->connect("dbi:SQLite:dbname=$Bin/../etc/".(conf_get('database:filename'))[0][0]) or err(2, 'Failed to connect to database!', 1); $DB = DBI->connect("dbi:SQLite:dbname=$bin{etc}/".(conf_get('database:filename'))[0][0]) or err(2, 'Failed to connect to database!', 1);
} }
when ('mysql') { when ('mysql') {
# MySQL. # MySQL.
if ($ENFEAT !~ /mysql/) { err(2, 'Auto not built with MySQL support. Aborting.', 1); } if ($ENFEAT !~ /mysql/) { err(2, 'Auto not built with MySQL support. Aborting.', 1) }
my @reqcval = qw(database:host database:name database:username database:password); my @reqcval = qw(database:host database:name database:username database:password);
foreach (@reqcval) { if (!conf_get($_)) { err(2, "Missing required configuration value $_. Aborting.", 1); } } foreach (@reqcval) { if (!conf_get($_)) { err(2, "Missing required configuration value $_. Aborting.", 1) } }
undef @reqcval; undef @reqcval;
# Import DBD::mysql. # Import DBD::mysql.
@@ -207,23 +301,11 @@ given (lc((conf_get('database:format'))[0][0])) {
(conf_get('database:username'))[0][0], (conf_get('database:password'))[0][0]) or err(2, 'Failed to connect to database!', 1);; (conf_get('database:username'))[0][0], (conf_get('database:password'))[0][0]) or err(2, 'Failed to connect to database!', 1);;
} }
} }
# CSV no work. :(
#when ('csv') {
# # CSV.
# if ($ENFEAT !~ /csv/) { err(2, 'Auto not built with CSV support.', 1); }
# if (!conf_get('database:dir')) { err(2, 'Missing required configuration value database:dir. Aborting.', 1); }
#
# # Import DBD::CSV.
# require DBD::CSV;
#
# # Connect to database.
# $DB = DBI->connect("dbi:CSV:f_dir=$Bin/../etc/".(conf_get('database:dir'))[0][0]) or err(2, 'Failed to connect to database!', 1);
#}
when ('pgsql') { when ('pgsql') {
# PostgreSQL. # PostgreSQL.
if ($ENFEAT !~ /pgsql/) { err(2, 'Auto not built with PostgreSQL support. Aborting.', 1); } if ($ENFEAT !~ /pgsql/) { err(2, 'Auto not built with PostgreSQL support. Aborting.', 1) }
my @reqcval = qw(database:name database:host database:username database:password); my @reqcval = qw(database:name database:host database:username database:password);
foreach (@reqcval) { if (!conf_get($_)) { err(2, "Missing required configuration value $_. Aborting.", 1); } } foreach (@reqcval) { if (!conf_get($_)) { err(2, "Missing required configuration value $_. Aborting.", 1) } }
undef @reqcval; undef @reqcval;
# Import DBD::Pg. # Import DBD::Pg.
@@ -242,7 +324,7 @@ given (lc((conf_get('database:format'))[0][0])) {
} }
} }
# Unknown database format. # Unknown database format.
default { err(2, 'Unknown database format \''.lc((conf_get('database:format'))[0][0]).'\'. Aborting.', 1); } default { err(2, 'Unknown database format \''.lc((conf_get('database:format'))[0][0]).'\'. Aborting.', 1) }
} }
@@ -303,6 +385,14 @@ our $STARTTIME = time;
say '* Auto successfully started at '.POSIX::strftime('%Y-%m-%d %I:%M:%S %p', localtime).q{.}; say '* Auto successfully started at '.POSIX::strftime('%Y-%m-%d %I:%M:%S %p', localtime).q{.};
alog 'Auto successfully started.'; alog 'Auto successfully started.';
# If we're on Windows, disable forking.
if ($OSNAME =~ /win/i) {
if (!$DEBUG) {
say '!!! Forking unavailable (OS is Microsoft Windows), continuing in debug mode.';
$DEBUG = 1;
}
}
# Fork into the background if not in debug mode. # Fork into the background if not in debug mode.
if (!$DEBUG) { if (!$DEBUG) {
say '*** Becoming a daemon...'; say '*** Becoming a daemon...';
@@ -312,10 +402,11 @@ if (!$DEBUG) {
$APID = fork; $APID = fork;
if ($APID != 0) { if ($APID != 0) {
alog '* Successfully forked into the background. Process ID: '.$APID; alog '* Successfully forked into the background. Process ID: '.$APID;
if (!-e "$Bin/auto.pid") { # Figure out where to throw auto.pid.
system "touch $Bin/auto.pid"; my $pidfile;
} if ($UPREFIX) { $pidfile = "$bin{cwd}/auto.pid" }
open my $FPID, '>', "$Bin/auto.pid" or exit; else { $pidfile = "$Bin/auto.pid" }
open my $FPID, '>', $pidfile or exit;
print {$FPID} "$APID\n" or exit; print {$FPID} "$APID\n" or exit;
close $FPID or exit; close $FPID or exit;
exit; exit;
@@ -328,6 +419,12 @@ else {
# Events. # Events.
API::Std::event_add('on_preconnect'); API::Std::event_add('on_preconnect');
# CAP.
my %tcsvrs = conf_get('server');
foreach my $svr (keys %tcsvrs) {
$Proto::IRC::cap{$svr} = 'multi-prefix';
}
undef %tcsvrs;
# Load modules. # Load modules.
if (conf_get('module')) { if (conf_get('module')) {
@@ -346,103 +443,45 @@ my %cservers = conf_get('server');
# Set the socket hash and select instance. # Set the socket hash and select instance.
our (%SOCKET, $SELECT); our (%SOCKET, $SELECT);
$SELECT = IO::Select->new(); $SELECT = IO::Select->new();
my $it = 0;
# Iterate through each configured server. # Iterate through each configured server.
foreach my $cskey (keys %cservers) { foreach my $cskey (keys %cservers) {
# Prepare socket data. Lib::Auto::ircsock(\%{$cservers{$cskey}}, $cskey);
my %conndata = (
Proto => 'tcp',
LocalAddr => $cservers{$cskey}{'bind'}[0],
PeerAddr => $cservers{$cskey}{'host'}[0],
PeerPort => $cservers{$cskey}{'port'}[0],
Timeout => 20,
);
# Set IPv6/SSL data.
my $use6 = 0;
my $usessl = 0;
if (defined $cservers{$cskey}{'ipv6'}[0]) { $use6 = $cservers{$cskey}{'ipv6'}[0]; }
if (defined $cservers{$cskey}{'ssl'}[0]) { $usessl = $cservers{$cskey}{'ssl'}[0]; }
# CertFP.
if ($usessl) {
if (defined $cservers{$cskey}{'certfp'}[0]) {
if ($cservers{$cskey}{'certfp'}[0] eq 1) {
$conndata{'SSL_use_cert'} = 1;
if (defined $cservers{$cskey}{'certfp_cert'}[0]) {
$conndata{'SSL_cert_file'} = "$Bin/../etc/certs/".$cservers{$cskey}{'certfp_cert'}[0];
}
if (defined $cservers{$cskey}{'certfp_key'}[0]) {
$conndata{'SSL_key_file'} = "$Bin/../etc/certs/".$cservers{$cskey}{'certfp_key'}[0];
}
if (defined $cservers{$cskey}{'certfp_pass'}[0]) {
$conndata{'SSL_passwd_cb'} = sub { return $cservers{$cskey}{'certfp_pass'}[0]; };
}
}
}
}
# Create the socket.
if ($use6) {
$SOCKET{$cskey} = IO::Socket::INET6->new(%conndata) or # Or error.
err(2, 'Failed to connect to server ('.$ERRNO.'): '.$cskey.' ['.$cservers{$cskey}{'host'}[0].q{:}.$cservers{$cskey}{'port'}[0].']', 0)
and delete $SOCKET{$cskey} and next;
}
else {
if ($usessl) {
$SOCKET{$cskey} = IO::Socket::SSL->new(%conndata) or # Or error.
err(2, 'Failed to connect to server ('.$ERRNO.'): '.$cskey.' ['.$cservers{$cskey}{'host'}[0].q{:}.$cservers{$cskey}{'port'}[0].']', 0)
and delete $SOCKET{$cskey} and next;
}
else {
$SOCKET{$cskey} = IO::Socket::INET->new(%conndata) or # Or error.
err(2, 'Failed to connect to server ('.$ERRNO.'): '.$cskey.' ['.$cservers{$cskey}{'host'}[0].q{:}.$cservers{$cskey}{'port'}[0].']', 0)
and delete $SOCKET{$cskey} and next;
}
}
# Send PASS if we have one.
if (defined $cservers{$cskey}{'pass'}[0]) {
socksnd($cskey, 'PASS :'.$cservers{$cskey}{'pass'}[0]) or
err(2, 'Failed to connect to server: '.$cskey.' ['.$cservers{$cskey}{'host'}[0].q{:}.$cservers{$cskey}{'port'}[0].']', 0)
and next;
}
API::Std::event_run('on_preconnect', $cskey);
# Send NICK/USER.
API::IRC::nick($cskey, $cservers{$cskey}{'nick'}[0]);
socksnd($cskey, 'USER '.$cservers{$cskey}{'ident'}[0].q{ }.hostname.q{ }.$cservers{$cskey}{'host'}[0].' :'.$cservers{$cskey}{'realname'}[0]) or
err(2, 'Failed to connect to server: '.$cskey.' ['.$cservers{$cskey}{'host'}[0].q{:}.$cservers{$cskey}{'port'}[0].']', 0)
and next;
# Add to select.
$SELECT->add($SOCKET{$cskey});
# Success!
alog '** Successfully connected to server: '.$cskey;
dbug '** Successfully connected to server: '.$cskey;
$it = 1;
} }
# Success! # Success!
if ($it) { if (keys %SOCKET) {
alog '** Success: Connected to server(s).'; alog '** Success: Connected to server(s).';
dbug '** Success: Connected to server(s).'; dbug '** Success: Connected to server(s).';
} }
else { else {
err(2, 'No server connections.', 1); err(2, 'No IRC connections -- Exiting program.', 1);
} }
undef $it;
# Create core commands. # Create core commands.
API::Std::cmd_add('MODLOAD', 1, 'cfunc.modules', \%Core::Cmd::HELP_MODLOAD, \&Core::Cmd::cmd_modload); API::Std::cmd_add('MODLOAD', 1, 'cfunc.modules', \%Core::Cmd::HELP_MODLOAD, \&Core::Cmd::cmd_modload);
API::Std::cmd_add('MODUNLOAD', 1, 'cfunc.modules', \%Core::Cmd::HELP_MODUNLOAD, \&Core::Cmd::cmd_modunload); API::Std::cmd_add('MODUNLOAD', 1, 'cfunc.modules', \%Core::Cmd::HELP_MODUNLOAD, \&Core::Cmd::cmd_modunload);
API::Std::cmd_add('MODRELOAD', 1, 'cfunc.modules', \%Core::Cmd::HELP_MODRELOAD, \&Core::Cmd::cmd_modreload); API::Std::cmd_add('MODRELOAD', 1, 'cfunc.modules', \%Core::Cmd::HELP_MODRELOAD, \&Core::Cmd::cmd_modreload);
API::Std::cmd_add('MODLIST', 1, 'cfunc.modules', \%Core::Cmd::HELP_MODLIST, \&Core::Cmd::cmd_modlist);
API::Std::cmd_add('SHUTDOWN', 2, 'cmd.shutdown', \%Core::Cmd::HELP_SHUTDOWN, \&Core::Cmd::cmd_shutdown); API::Std::cmd_add('SHUTDOWN', 2, 'cmd.shutdown', \%Core::Cmd::HELP_SHUTDOWN, \&Core::Cmd::cmd_shutdown);
API::Std::cmd_add('RESTART', 2, 'cmd.restart', \%Core::Cmd::HELP_RESTART, \&Core::Cmd::cmd_restart); API::Std::cmd_add('RESTART', 2, 'cmd.restart', \%Core::Cmd::HELP_RESTART, \&Core::Cmd::cmd_restart);
API::Std::cmd_add('REHASH', 2, 'cmd.rehash', \%Core::Cmd::HELP_REHASH, \&Core::Cmd::cmd_rehash); API::Std::cmd_add('REHASH', 2, 'cmd.rehash', \%Core::Cmd::HELP_REHASH, \&Core::Cmd::cmd_rehash);
API::Std::cmd_add('HELP', 2, 0, \%Core::Cmd::HELP_HELP, \&Core::Cmd::cmd_help); API::Std::cmd_add('HELP', 2, 0, \%Core::Cmd::HELP_HELP, \&Core::Cmd::cmd_help);
# Aliases, if any.
if (conf_get('aliases:alias')) {
my $aliases = (conf_get('aliases:alias'))[0];
foreach (@{$aliases}) {
if ($_ =~ m/\s/xsm) {
my @data = split /\s/xsm, $_;
API::Std::cmd_alias($data[0], join ' ', @data[1..$#data]);
}
}
}
# Infinite while loop. # Infinite while loop.
while (1) { while (1) {
# Timer check. # Timer check.
foreach my $tk (keys %TIMERS) { foreach my $tk (keys %TIMERS) {
if (exists $TIMERS{$tk}) {
if ($TIMERS{$tk}{time} <= time) { if ($TIMERS{$tk}{time} <= time) {
&{ $TIMERS{$tk}{sub} }(); &{ $TIMERS{$tk}{sub} }();
if ($TIMERS{$tk}{type} == 1) { if ($TIMERS{$tk}{type} == 1) {
@@ -459,12 +498,13 @@ while (1) {
} }
} }
} }
}
# Socket check. # Socket check.
foreach my $sock ($SELECT->can_read(1)) { foreach my $sock ($SELECT->can_read(1)) {
# Figure out what network is sending us data. # Figure out what network is sending us data.
my $sockid; my $sockid;
foreach (keys %SOCKET) { foreach (keys %SOCKET) {
if ($SOCKET{$_} eq $sock) { $sockid = $_; } if ($SOCKET{$_} eq $sock) { $sockid = $_ }
} }
# Read the data. # Read the data.
my $idata; my $idata;
@@ -476,6 +516,7 @@ while (1) {
err(2, "Lost connection to $sockid!", 0); err(2, "Lost connection to $sockid!", 0);
$SELECT->remove($sock); $SELECT->remove($sock);
delete $SOCKET{$sockid}; delete $SOCKET{$sockid};
API::Std::event_run('on_disconnect', $sockid);
if (!keys %SOCKET) { if (!keys %SOCKET) {
# No more connections, stop the program. # No more connections, stop the program.
API::Std::event_run('on_shutdown'); API::Std::event_run('on_shutdown');
@@ -498,7 +539,7 @@ while (1) {
dbug $sockid.' >> '.$line; dbug $sockid.' >> '.$line;
# Parse data. # Parse data.
Parser::IRC::ircparse($sockid, $line); Proto::IRC::ircparse($sockid, $line);
} }
} }
} }
@@ -508,17 +549,16 @@ while (1) {
############### ###############
# Send data to socket. # Send data to socket.
sub socksnd sub socksnd {
{
my ($svr, $data) = @_; my ($svr, $data) = @_;
if (defined $SOCKET{$svr}) { if (defined $SOCKET{$svr}) {
syswrite $SOCKET{$svr}, $data."\n", POSIX::BUFSIZ, 0; syswrite $SOCKET{$svr}, "$data\r\n", POSIX::BUFSIZ, 0;
dbug "$svr << $data"; dbug "$svr << $data";
return 1; return 1;
} }
else { else {
return 0; return;
} }
} }
@@ -526,12 +566,12 @@ sub socksnd
sub mod_load { sub mod_load {
my ($module) = @_; my ($module) = @_;
if (-e "$Bin/../modules/$module.pm") { if (-e "$bin{mod}/$module.pm") {
do "$Bin/../modules/$module.pm" and return 1; do "$bin{mod}/$module.pm" and return 1;
} }
else { else {
if (-e "$Bin/../modules/$module/main.pm") { if (-e "$bin{mod}/$module/main.pm") {
do "$Bin/../modules/$module/main.pm" and return 1; do "$bin{mod}/$module/main.pm" and return 1;
} }
} }
@@ -546,4 +586,4 @@ sub mod_load {
return; return;
} }
# vim: set ai sw=4 ts=4: # vim: set ai et sw=4 ts=4:
+56 -17
View File
@@ -8,12 +8,45 @@ use strict;
use warnings; use warnings;
use English qw(-no_match_vars); use English qw(-no_match_vars);
use FindBin qw($Bin); use FindBin qw($Bin);
use Cwd;
use Pod::Html; use Pod::Html;
use Pod::Man; use Pod::Man;
our $Bin = $Bin; our $Bin = $Bin;
our $VERSION = 1.00; our $VERSION = 1.00;
my ($UPREFIX, %bin);
$bin{cwd} = getcwd;
if (!-e "$Bin/../build/syswide") {
# Must be a custom PREFIX install.
$bin{etc} = "$bin{cwd}/etc";
$bin{var} = "$bin{cwd}/var";
if (!-e "$Bin/lib/Lib/Auto.pm") {
# Must be a system wide install.
$bin{lib} = "$Bin/../lib/autobot/3.0.0";
$bin{bld} = "$bin{lib}/build";
$bin{lng} = "$bin{lib}/lang";
$bin{mod} = "$bin{lib}/modules";
}
else {
# Or not.
$bin{lib} = "$Bin/../lib";
$bin{bld} = "$Bin/../build";
$bin{lng} = "$Bin/../lang";
$bin{mod} = "$Bin/../modules";
}
$UPREFIX = 1;
}
else {
# Must be a standard install.
$bin{etc} = "$Bin/../etc";
$bin{var} = "$Bin/../var";
$bin{lib} = "$Bin/../lib";
$bin{bld} = "$Bin/../build";
$bin{lng} = "$Bin/../lang";
$bin{mod} = "$Bin/../modules";
$UPREFIX = 0;
}
# Get module parameter. # Get module parameter.
if (!defined $ARGV[0]) { if (!defined $ARGV[0]) {
say 'Not enough parameters. Usage: buildmod <module>'; say 'Not enough parameters. Usage: buildmod <module>';
@@ -24,13 +57,13 @@ my $module = $ARGV[0];
# Set full path. # Set full path.
my $type = 0; my $type = 0;
my $modulep; my $modulep;
if (-e "$Bin/../modules/$module.pm") { if (-e "$bin{mod}/$module.pm") {
$modulep = "$Bin/../modules/$module.pm"; $modulep = "$bin{mod}/$module.pm";
$type = 1; $type = 1;
} }
else { else {
if (-e "$Bin/../modules/$module/Buildfile") { if (-e "$bin{mod}/$module/Buildfile") {
$modulep = "$Bin/../modules/$module/Buildfile"; $modulep = "$bin{mod}/$module/Buildfile";
$type = 2; $type = 2;
} }
else { else {
@@ -95,17 +128,17 @@ foreach (@pars) {
foreach my $cpanmod (@vals) { foreach my $cpanmod (@vals) {
$res = eval('require '.$cpanmod.'; 1;'); $res = eval('require '.$cpanmod.'; 1;');
say ' '.$cpanmod.': '.(($res) ? 'Found' : 'Not Found'); say ' '.$cpanmod.': '.(($res) ? 'Found' : 'Not Found');
if (!$res) { $die = 1; } if (!$res) { $die = 1 }
} }
print $RS; print $RS;
if ($die) { say 'Failed to build '.$module.'.'; exit; } if ($die) { say 'Failed to build '.$module.'.'; exit }
} }
when ('perl') { when ('perl') {
print 'Checking Perl version..... '.$PERL_VERSION.' - '; print 'Checking Perl version..... '.$PERL_VERSION.' - ';
if ($] < $val) { $die = 1; } if ($] < $val) { $die = 1 }
say (($die) ? 'Not OK' : 'OK'); say (($die) ? 'Not OK' : 'OK');
if ($die) { say 'Failed to build '.$module.'.'; exit; } if ($die) { say 'Failed to build '.$module.'.'; exit }
} }
} }
} }
@@ -119,35 +152,41 @@ close $FMPH;
say 'Generating documentation.....'; say 'Generating documentation.....';
my $podbuf; my $podbuf;
foreach my $line (@MPBUF) { foreach my $line (@MPBUF) {
if (!defined $line) { $line = ' '; } if (!defined $line) { $line = ' ' }
$line =~ s/(\r|\n)//g; $line =~ s/(\r|\n)//g;
if ($line eq '__END__') { if ($line eq '__END__') {
$got_end = 1; $got_end = 1;
} }
if ($got_end and $line ne '__END__') { if ($got_end and $line ne '__END__' and $line !~ m/^# vim:/sm) {
$podbuf .= $line."\n"; $podbuf .= $line."\n";
} }
} }
# Create the autodoc/ dir if it doesn't exist. # Create the autodoc/ dir if it doesn't exist.
if (!-d "$Bin/../autodoc") { my $docdir;
mkdir "$Bin/../autodoc"; if ($UPREFIX) {
$docdir = "$ENV{HOME}/autodoc";
if (!-d "$ENV{HOME}/autodoc") { mkdir "$ENV{HOME}/autodoc" }
}
else {
$docdir = "$Bin/../autodoc";
if (!-d "$Bin/../autodoc") { mkdir "$Bin/../autodoc" }
} }
# Save to POD file in autodoc/ # Save to POD file in autodoc/
open my $FMPNH, '>', "$Bin/../autodoc/$module.pod"; open my $FMPNH, '>', "$docdir/$module.pod";
print {$FMPNH} $podbuf; print {$FMPNH} $podbuf;
close $FMPNH; close $FMPNH;
# Create HTML. # Create HTML.
pod2html("--infile=$Bin/../autodoc/$module.pod", "--outfile=$Bin/../autodoc/$module.html"); pod2html("--infile=$docdir/$module.pod", "--outfile=$docdir/$module.html");
# Create *roff. # Create *roff.
my $manifier = Pod::Man->new(); my $manifier = Pod::Man->new();
$manifier->parse_from_file("$Bin/../autodoc/$module.pod", "$Bin/../autodoc/$module.1"); $manifier->parse_from_file("$docdir/$module.pod", "$docdir/$module.1");
print $RS; print $RS;
say 'Done.'; say 'Done.';
# vim: set ai sw=4 ts=4: # vim: set ai et sw=4 ts=4:
+1 -1
View File
@@ -58,4 +58,4 @@ foreach (@violations) {
} }
say "$count violations in $ARGV[0]."; say "$count violations in $ARGV[0].";
# vim: set ai sw=4 ts=4: # vim: set ai et sw=4 ts=4:
+41 -7
View File
@@ -9,8 +9,42 @@ use 5.010_000;
use strict; use strict;
use warnings; use warnings;
use FindBin qw($Bin); use FindBin qw($Bin);
use Cwd;
our $VERSION = 1.00; our $VERSION = 1.00;
my $bin = $Bin; my $Bin = $Bin;
my ($UPREFIX, %bin);
$bin{cwd} = getcwd;
if (!-e "$Bin/../build/syswide") {
# Must be a custom PREFIX install.
$bin{etc} = "$bin{cwd}/etc";
$bin{var} = "$bin{cwd}/var";
if (!-e "$Bin/lib/Lib/Auto.pm") {
# Must be a system wide install.
$bin{lib} = "$Bin/../lib/autobot/3.0.0";
$bin{bld} = "$bin{lib}/build";
$bin{lng} = "$bin{lib}/lang";
$bin{mod} = "$bin{lib}/modules";
}
else {
# Or not.
$bin{lib} = "$Bin/../lib";
$bin{bld} = "$Bin/../build";
$bin{lng} = "$Bin/../lang";
$bin{mod} = "$Bin/../modules";
}
$UPREFIX = 1;
}
else {
# Must be a standard install.
$bin{etc} = "$Bin/../etc";
$bin{var} = "$Bin/../var";
$bin{lib} = "$Bin/../lib";
$bin{bld} = "$Bin/../build";
$bin{lng} = "$Bin/../lang";
$bin{mod} = "$Bin/../modules";
$UPREFIX = 0;
}
# Get the name of the network this cert is for. # Get the name of the network this cert is for.
print 'Network Name: '; print 'Network Name: ';
@@ -19,15 +53,15 @@ $net =~ s/(\r|\n)//gxsm;
say q{}; say q{};
# Make sure etc/certs/ exists. # Make sure etc/certs/ exists.
if (!-d "$bin/../etc") { mkdir "$bin/../etc", 0755; } if (!-d "$bin{etc}") { mkdir "$bin{etc}", 0755 }
if (!-d "$bin/../etc/certs") { mkdir "$bin/../etc/certs", 0755; } if (!-d "$bin{etc}/certs") { mkdir "$bin{etc}/certs", 0755 }
# Generate key and cert. # Generate key and cert.
system 'openssl req -nodes -newkey rsa:2048 -keyout '.$bin.'/../etc/certs/'.$net.'.key -x509 -days 3650 -out '.$bin.'/../etc/certs/'.$net.'.cert'; system "openssl req -nodes -newkey rsa:2048 -keyout $bin{etc}/certs/$net.key -x509 -days 3650 -out $bin{etc}/certs/$net.cert";
chmod 0400, "$bin/../etc/certs/$net.key"; chmod 0400, "$bin{etc}/certs/$net.key";
# Get the fingerprint. # Get the fingerprint.
my $fpr = `openssl x509 -noout -fingerprint < $bin/../etc/certs/$net.cert`; my $fpr = `openssl x509 -noout -fingerprint < $bin{etc}/certs/$net.cert`;
my $fp; my $fp;
while ($fpr =~ s/(.*\n)//) { while ($fpr =~ s/(.*\n)//) {
my $line = $1; my $line = $1;
@@ -44,4 +78,4 @@ while ($fpr =~ s/(.*\n)//) {
# Print the fingerprint. # Print the fingerprint.
say 'Done. Fingerprint: '.$fp; say 'Done. Fingerprint: '.$fp;
# vim: set ai sw=4 ts=4: # vim: set ai et sw=4 ts=4:
Executable
+53
View File
@@ -0,0 +1,53 @@
#!/usr/bin/env perl
# bin/wizard - Wizard for creating local Auto configuration directories.
# Copyright (C) 2010-2011 Xelhua Development Group, et al.
# This program is free software; rights to this code are stated in doc/LICENSE.
use 5.010_000;
use strict;
use warnings;
use Cwd;
use FindBin qw($Bin);
use File::Copy;
our $VERSION = 1.00;
my $Bin = $Bin;
# Get current working directory.
my $cwd = getcwd();
# One argument required.
if (!defined $ARGV[0]) {
say 'ERROR: Missing arguments.';
say 'Usage: auto-wizard <directory>';
exit;
}
# Strip trailing slash.
my $installdir = $ARGV[0];
$installdir =~ s/\/$//xsm;
# Create missing directories.
if (!-d "$cwd/$installdir") { mkdir "$cwd/$installdir" }
if (!-d "$cwd/$installdir/etc") { mkdir "$cwd/$installdir/etc" }
if (!-d "$cwd/$installdir/var") { mkdir "$cwd/$installdir/var" }
# Copy over example.conf.
copy("$Bin/../lib/autobot/3.0.0/dist/example.conf", "$cwd/$installdir/etc/example.conf");
chmod 0644, "$cwd/$installdir/etc/example.conf";
# Our work is done.
print <<"MSG";
Successfully installed to "$cwd/$installdir"!
I've also created an example.conf for you and left it in etc/, configure it and
rename it to auto.conf or any name of your choice.
See the Xelhua Wiki at http://wiki.xelhua.org for complete documentation.
After that, change directory to "$cwd/$installdir" and run `$Bin/auto` (or if
"$Bin" is in your PATH; just `auto`).
If you gave your config file a name other than auto.conf, pass -c=FILENAME to
`auto`, like so, if your config is etc/foo.conf: $Bin/auto -c=foo.conf
Enjoy.
MSG
+154
View File
@@ -2,6 +2,160 @@ Auto IRC Bot 3.0: Change Log
------------------------------------------------------------------------------- -------------------------------------------------------------------------------
3.0 Indev 3.0 Indev
===============================================================================
* Werewolf 1.07: Various improvements.
* Updated Core::IRC::Users to be more efficient.
* Added a WerewolfAdmin module for administering the Werewolf IRC game.
* Fixed significant state mismatched data bugs.
* Added API::IRC::ison for checking if a user is on a channel.
* Werewolf: Fixed a bug in harlot staying home.
* Werewolf: Various bug fixes.
* Werewolf 1.06: Fixed an annoyance and added traitor transformation.
* Commands now work with prefixes even in PM.
* Ping: Determines end by numeric 315 instead of a 3-second timer now.
* Werewolf: Fixed a GUARD issue and made it possible to VISIT yourself.
* Possibly fixed a rare fatal error.
* Werewolf: Rewrote WAIT to be more decent.
* Werewolf: Wounded villagers are now excluded from winning villager count.
* Werewolf: Dynamic lynch and no victim messages.
* Werewolf 1.05: Added WAIT command.
* Werewolf: Improved STATS to be smart.
* Werewolf 1.04: Added village drunks and fixed other issues.
* Werewolf: Fixed various annoyances. Also raised chance of gun hitting.
* Werewolf: Fixed a nasty lynch nick exploit.
* Fixed an issue in HELP.
* Added a Ping module.
* Moved Werewolf back to stable.
3.0 Alpha 10
===============================================================================
* Werewolf moved to unstable/ for exclusion from alpha10.
* Werewolf: Fixed a bug causing double lynches occasionally.
* Werewolf: One bug fix and multiple bullets.
* Werewolf: Fixed timeout bug.
* Werewolf: Fixed various warnings.
* Werewolf: Handful of bugs fixed, timeouts rewritten, wolf assignment
rewritten. (see ROLES:Werewolf)
* Werewolf: Fixed an annoyance in VOTES.
* Werewolf: Fixed another round of bugs.
* Werewolf: Fixed a grammatical error. Thanks TAD!
* Werewolf: Fixed a bug that occasionally caused a person to get wolf
twice in the same game.
* Werewolf: Fixed a typo that broke the gun on occasion.
* Fixed a minor retract bug in Werewolf.
* Fixed two major bugs in Werewolf that messed up game play.
* Fixed several bugs and changed around JOIN/START/BEGIN in Werewolf.
* Fixed parsing of host masks with / in them. (if it was broken)
* Werewolf: Fixed a leave before game begin bug.
* Aliases now work in PM's to the bot too.
* Added an epic, Werewolf module.
* Made slog() saner.
* Syntax for mod_init() changed. Package name is no longer required.
* Added German translation to Greet help hash. - nridley
* Added German translation to FML help hash. - nridley
* Added German translation to Eval help hash. - nridley
* Added German translation to EightBall help hash. - nridley
* Added German translation to Dictionary help hash. - nridley
* Added German translation to Calc help hash. - nridley
* Added German translation to Bitly help hash. - nridley
* Added German translation to AUR help hash. - nridley
3.0 Alpha 9
===============================================================================
* Bug fix: Fixed an exploit in QDB RAND.
* UNO: Fixed a formatting issue in duration.
3.0 Alpha 8
===============================================================================
* Full support for custom PREFIX installs (including global installs) has
been completed.
* Added fastest/slowest game, most cards and most players records to UNO.
* Fixed a bug in UNO that allowed users to join more than once.
* Added optional uno:english option. See documentation for UNO.
* UNO has a new config option, uno:msg, for setting what method the bot
uses for private messages.
* Added command aliasing.
* Moved botinfo to State::IRC.
* Added hook on_selfkick for when we are kicked from a channel.
* Moved chanusers to State::IRC.
* Created State::IRC.
* UNO now keeps game duration and cards played count.
* Added a LOLCAT module for translating English to LOLCAT.
* EightBall module rewritten.
* Fixed a bug in LinkTitle that caused multi-line <title>'s to display
wrong.
* Added `wizard`, for creating local Auto config directories.
* Made Auto respond properly to PRIVMSGs received before connection.
* Added an AUR module.
* Fixed an exploit in QDB that allowed users to use services fantasy
commands with the bot's account.
* Heavily improved ./install.
3.0 Alpha 7
===============================================================================
* Fixed a bug in UNO where rehashing during a game caused a crash.
* Proto::IRC::umodes renamed to Proto::IRC::botinfo{svr}{modes}.
* Fixed a bug where incoming PART's from ourselves were not parsed.
* Our usermodes are now tracked in Proto::IRC::umodes.
* Added an Oper module.
* Added events on_cmode and on_umode.
* Added event on_myinfo for RPL_MYINFO (numeric 004).
* Raw hooks now take hook names and support multiple hooks. This changes
rchook_add and rchook_del.
* Vim modelines must be at the bottom of files. Modules updated.
* Renamed Lib::Users to Core::IRC::Users.
* Added Lib::Users, for network-wide user tracking. This brings many new
possibilities to modules, including an account system.
* Added hook on_namesreply.
* All data related to a network is now deleted on disconnect.
* Added hook on_disconnect.
* Added various options to bin/auto, including support for multiple config
files. See bin/auto -h for details.
* Changed on_nick, on_quit, on_part, and on_kick source hashrefs to include
server, removing svr.
* Bumped minimum API version to 3.0.0a7.
* Fixed the arguments on_whoreply passes.
3.0 Alpha 6
===============================================================================
* Bug fix: Fixed an issue with SASL timeout.
* Added hook on_capack.
* CAP is now core.
* Fixed a bug with multi-prefix support.
* Added fpfmt() to API::Std.
* Auto::GR renamed to $Auto::VERGITREV.
* Bumped minimum version for API to 3.0.0a6.
* Changed on_topic args to: full source hashref, new topic array
* on_topic is now triggered for any topic change, regardless of source.
* Now parsing numeric 004.
* Added hook on_isupport.
* Added a BotStats module for returning statistics about the bot.
* Now parsing numeric 396.
* Added who() to API::IRC.
* Added hook on_whoreply.
* PRIVMSGs and NOTICEs that would cause a >512 bytes resulting message are
now divided into multiple messages.
* Renamed botnick to botinfo.
* Renamed Parser::IRC to Proto::IRC.
* Added an Eval module.
* Added an UNO module.
* Added on_part hook.
3.0 Alpha 5
===============================================================================
* Bug fix: Fixed broken rehash.
* Ignore PRIVMSG's if they're from an invalid source.
* Fixed an odd bug when viewing non-existent quotes.
* You can now define how many results are returned by QDB SEARCH/MORE at a
time with qdb_search_resnum in the config.
* Added SEARCH and MORE to QDB.
* Killed EMODS in the starter script and updated MODS
* Added core command MODLIST.
* Added command level 3 for logchan-only command.
* Added a LinkTitle module for getting the title of a web page posted in a
channel.
3.0 Alpha 4
=============================================================================== ===============================================================================
* Added a Dictionary module for looking up definitions of words. * Added a Dictionary module for looking up definitions of words.
* server:ajoin now supports channel keys by spacing the name and key. * server:ajoin now supports channel keys by spacing the name and key.
+4
View File
@@ -9,6 +9,10 @@ Chazz "Alexandria" Wolcott <alyx@woomoo.org>
Matthew "Mab879" Burket <matthew@assignitapp.com> Matthew "Mab879" Burket <matthew@assignitapp.com>
- Spanish translations - Spanish translations
Noah "nridley" Ridley <nridley44@gmail.com>
- Various.
Eitan "variable" Adler <lists@eitanadler.com>
- Werewolf improvements.
----------------------------------------------- -----------------------------------------------
+7 -5
View File
@@ -10,6 +10,7 @@ Legend:
[ ] Cleanup [ ] Cleanup
[ ] Replace println with Perl 5.10's say. [ ] Replace println with Perl 5.10's say.
[ ] Fix inconsistencies in official modules
[X] Language [X] Language
[X] Create method of translation. [X] Create method of translation.
@@ -18,6 +19,7 @@ Legend:
[X] Add English strings [X] Add English strings
[X] Add Spanish strings [X] Add Spanish strings
[X] Add French strings [X] Add French strings
[ ] Add Spanish, French and German translations to all official command help hashes.
[!] API [!] API
[X] Create basic modular functions [X] Create basic modular functions
@@ -41,18 +43,18 @@ Legend:
[!] Features [!] Features
[X] Weather module [X] Weather module
[!] Urban Dictionary module [ ] Urban Dictionary module
[ ] UNO module [X] UNO module
[ ] Google Search module [ ] Google Search module
[ ] IRC Relay module [ ] IRC Relay module
[ ] (Google?) News module [ ] (Google?) News module
[X] QDB module [X] QDB module
[ ] Tumblr module [!] Tumblr module
[X] Google Calculator module [X] Google Calculator module
[ ] YouTube Search module [ ] YouTube Search module
[ ] Twitter module [ ] Twitter module
[!] Advanced Topics module [X] Advanced Topics module
[ ] Custom Triggers module [!] Custom Triggers module
[X] Shorten URL (bit.ly?) module [X] Shorten URL (bit.ly?) module
[?] Bot Talk module [?] Bot Talk module
[O] Minecraft<->IRC module [O] Minecraft<->IRC module
+18
View File
@@ -0,0 +1,18 @@
Auto IRC Bot 3.0: Microsoft Windows Notes
===============================================================================
When running Auto on Microsoft Windows, you should be aware of the following:
* Windows support has not been thoroughly tested, some scripts/features may not
function correctly.
* Forking into the background is disabled.
* Some file system operations may fail if Auto is installed to a path with
spaces. Please report these.
For the full power of Auto; run him in a UNIX environment.
Since Windows support can be considered experimental, testers are welcome and
you should report anything you find to malfunction.
At some point in the future, we hope to achieve Windows support with no core
caveats. Again, reporting issues in Auto on Windows is highly appreciated.
+7
View File
@@ -86,6 +86,13 @@ user "#bot-ops" {
privs "op"; privs "op";
} }
# Command aliases.
# These can be used to alias a shortcut to a longer command.
# Like so: alias "PL UNO PLAY";
aliases {
alias "RELOAD REHASH";
}
# Database. # Database.
database { database {
# Format. This can be one of the following: # Format. This can be one of the following:
+121 -49
View File
@@ -6,49 +6,78 @@
package Install; package Install;
use strict; use strict;
use warnings; use warnings;
use Getopt::Long;
use English qw(-no_match_vars); use English qw(-no_match_vars);
use FindBin qw($Bin); use FindBin qw($Bin);
use File::Copy;
use File::Path qw(make_path remove_tree);
our $Bin = $Bin; our $Bin = $Bin;
BEGIN { unshift(@INC, "$Bin/lib"); } BEGIN { unshift(@INC, "$Bin/lib") }
use Lib::Install; use Lib::Install;
# Installation script. # Installation script.
our $VERSION = 1.00; our $VERSION = 1.00;
our $ERROR = 0; our $ERROR = 0;
# Iterate through the arguments passed to us. # Store the arguments passed to us.
my $features = 'base ssl sqlite'; my ($opt_help, $opt_syswide, $PREFIX, $feature_nossl, $feature_sasl, $feature_ipv6, $feature_mysql, $feature_pgsql);
if (defined $ARGV[0]) { GetOptions(
foreach (@ARGV) { '--disable-ssl' => \$feature_nossl,
if ($_ eq '-h' or $_ eq '--help') { '--enable-sasl' => \$feature_sasl,
println '*** ./install help ***'; '--enable-ipv6' => \$feature_ipv6,
println ' --enable-sasl - Enable support for SASL.'; '--with-mysql' => \$feature_mysql,
println ' --enable-ipv6 - Enable support for IPv6.'; '--with-pgsql' => \$feature_pgsql,
println ' --disable-ssl - Disable support for SSL.'; '--prefix=s' => \$PREFIX,
println '*** End of Help ***'; '--syswide' => \$opt_syswide,
'--help' => \$opt_help,
);
# If --help was passed.
if ($opt_help) {
print <<"HELP";
Auto IRC Bot Installation Wizard (v1.00).
Usage: perl install [options]
Options:
--disable-ssl Disables SSL support.
--enable-sasl Enables SASL support.
--enable-ipv6 Enables IPv6 support.
--with-mysql Uses MySQL instead of SQLite.
--with-pgsql Uses PostgreSQL instead of SQLite.
--syswide Prefixes bin/ files with auto- (excluding `auto` itself), as
well as installs build/ to lib/ instead. Always use this
when installing to /usr.
--prefix=PREFIX Installs files to PREFIX
[$Bin]
HELP
exit 1; exit 1;
}
elsif ($_ eq '--enable-sasl') {
$features .= ' sasl';
}
elsif ($_ eq '--disable-ssl') {
$features =~ s/ ssl//g;
}
elsif ($_ eq '--enable-ipv6') {
$features .= ' ipv6';
}
elsif ($_ eq '--with-mysql') {
$features =~ s/(sqlite|pgsql)/mysql/g;
}
elsif ($_ eq '--with-pgsql') {
$features =~ s/(sqlite|mysql)/pgsql/g;
}
else {
println "Warning: Unknown option '$_'";
}
}
} }
# Set features.
my $features = 'base';
$features .= ' ssl' unless $feature_nossl;
$features .= ' sasl' if $feature_sasl;
$features .= ' ipv6' if $feature_ipv6;
if ($feature_mysql) { $features .= ' mysql' }
elsif ($feature_pgsql) { $features .= ' pgsql' }
else { $features .= ' sqlite' }
# Where to install.
my $upref;
if (!$PREFIX) {
$PREFIX = $Bin;
$upref = 0;
}
else { $upref = 1 }
# Adjust installation to be more appropriate for system-wide installs.
my $libbuild = 0;
if ($opt_syswide) { $libbuild = 1 }
# Check Perl version. # Check Perl version.
println "Checking Perl version..... $^V"; println "Checking Perl version..... $^V";
eval { eval {
@@ -59,18 +88,21 @@ eval {
print "Checking operating system..... $OSNAME - "; print "Checking operating system..... $OSNAME - ";
if ($OSNAME =~ /dos/i) { if ($OSNAME =~ /dos/i) {
print "DOS is not supported.\r\n"; print "DOS is not supported.\r\n";
exit;
} }
elsif ($OSNAME eq "MSWin32") { elsif ($OSNAME eq "MSWin32") {
print "Microsoft Windows is not supported. Support is planned for the future.\r\n"; print "OK\r\n";
} }
elsif ($OSNAME eq "NetWare") { elsif ($OSNAME eq "NetWare") {
print "NetWare is not supported.\r\n"; print "NetWare is not supported.\r\n";
exit;
} }
elsif ($OSNAME eq "linux") { elsif ($OSNAME eq "linux") {
print "OK\n"; print "OK\n";
} }
elsif ($OSNAME eq "os2") { elsif ($OSNAME eq "os2") {
print "IBM OS/2 is not supported.\r\n"; print "IBM OS/2 is not supported.\r\n";
exit;
} }
elsif ($OSNAME =~ /mac/i or $OSNAME =~ /darwin/i) { elsif ($OSNAME =~ /mac/i or $OSNAME =~ /darwin/i) {
print "OK\r"; print "OK\r";
@@ -81,8 +113,12 @@ elsif ($OSNAME eq "freebsd") {
elsif ($OSNAME eq "openbsd") { elsif ($OSNAME eq "openbsd") {
print "OK\n"; print "OK\n";
} }
elsif ($OSNAME eq "solaris") {
print "OK\n";
}
else { else {
print "Unknown operating system. Contact support.\r\n"; print "Unknown operating system. Contact support.\r\n";
exit;
} }
# Check for Perl core modules. # Check for Perl core modules.
@@ -123,30 +159,66 @@ else {
# Create build. # Create build.
println "\0"; println "\0";
println "Building....."; println "Building.....";
if (!-d "$Bin/build") { if (!-d $PREFIX) { make_path($PREFIX) }
system "mkdir $Bin/build"; my $libdir;
} if ($libbuild) { $libdir = "$PREFIX/lib/autobot/3.0.0" }
if (!-e "$Bin/build/time") { else { $libdir = "$PREFIX/lib" }
system "touch $Bin/build/time"; my $builddir;
} if ($libbuild) { $builddir = "$libdir/build" }
if (!-e "$Bin/build/os") { else { $builddir = "$PREFIX/build" }
system "touch $Bin/build/os"; if (!-d $builddir) { make_path($builddir) }
} build($features, $builddir, $opt_syswide);
if (!-e "$Bin/build/perl") {
system "touch $Bin/build/perl"; # Install.
} if ($upref) {
if (!-e "$Bin/build/ver") { require File::Copy::Recursive;
system "touch $Bin/build/ver"; File::Copy::Recursive->import('rcopy');
my $langdir;
if ($libbuild) { $langdir = "$libdir/lang" }
else { $langdir = "$PREFIX/lang" }
my $moddir;
if ($libbuild) { $moddir = "$libdir/modules" }
else { $moddir = "$PREFIX/modules" }
my $distdir;
if ($libbuild) { $distdir = "$libdir/dist" }
else { $distdir = "$PREFIX/dist" }
println "Installing.....";
if (!-d "$PREFIX/bin") { make_path("$PREFIX/bin") }
if (!-d $libdir) { make_path($libdir) }
if (!-d $langdir) { make_path($langdir) }
if (!-d $moddir) { make_path($moddir) }
if (!-d $distdir) { make_path($distdir) }
my $bgenssl = 'genssl';
my $bbuildmod = 'buildmod';
my $bwizard = 'wizard';
if ($libbuild) {
$bgenssl = "auto-$bgenssl";
$bbuildmod = "auto-$bbuildmod";
$bwizard = "auto-$bwizard";
}
copy("$Bin/bin/auto", "$PREFIX/bin/auto");
copy("$Bin/bin/buildmod", "$PREFIX/bin/$bbuildmod");
copy("$Bin/bin/genssl", "$PREFIX/bin/$bgenssl");
copy("$Bin/bin/wizard", "$PREFIX/bin/$bwizard");
chmod 0755, "$PREFIX/bin/auto", "$PREFIX/bin/$bgenssl", "$PREFIX/bin/$bbuildmod", "$PREFIX/bin/$bwizard";
rcopy("$Bin/lib/*", "$libdir/");
rcopy("$Bin/lang/*", "$langdir/");
rcopy("$Bin/modules/*", "$moddir/");
copy("$Bin/etc/example.conf", "$distdir/");
remove_tree("$libdir/File");
} }
build($features);
println 'Done.'; println 'Done.';
println q{}; println q{};
installmods(); if ($libbuild) {
println 'To install modules, run the auto-buildmod utility on a module.';
}
else { installmods($PREFIX) }
println q{}; println q{};
# Success! # Success!
println "Done. Auto successfully installed."; println "Done. Auto successfully installed.";
# vim: set ai sw=4 ts=4: # vim: set ai et sw=4 ts=4:
+88 -57
View File
@@ -6,29 +6,30 @@ use strict;
use warnings; use warnings;
use feature qw(switch); use feature qw(switch);
use Exporter; use Exporter;
use base qw(Exporter);
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(ban cjoin cpart cmode umode kick privmsg notice quit nick names our @EXPORT_OK = qw(ban cjoin cpart cmode umode kick privmsg notice quit nick names
topic usrc match_mask); topic who whois usrc match_mask ison);
# Create the on_disconnect event.
API::Std::event_add('on_disconnect');
# Set a ban, based on config bantype value. # Set a ban, based on config bantype value.
sub ban sub ban {
{
my ($svr, $chan, $type, $user) = @_; my ($svr, $chan, $type, $user) = @_;
my $cbt = (API::Std::conf_get('bantype'))[0][0]; my $cbt = (API::Std::conf_get('bantype'))[0][0];
# Prepare the mask we're going to ban. # Prepare the mask we're going to ban.
my $mask; my $mask;
given ($cbt) { given ($cbt) {
when (1) { $mask = '*!*@'.$user->{host}; } when (1) { $mask = '*!*@'.$user->{host} }
when (2) { $mask = $user->{nick}.'!*@*'; } when (2) { $mask = $user->{nick}.'!*@*' }
when (3) { $mask = '*!'.$user->{user}.'@'.$user->{host}; } when (3) { $mask = q{*!}.$user->{user}.q{@}.$user->{host} }
when (4) { $mask = $user->{nick}.'!*'.$user->{user}.'@'.$user->{host}; } when (4) { $mask = $user->{nick}.q{!*}.$user->{user}.q{@}.$user->{host} }
when (5) { when (5) {
my @hd = split m/[\.]/, $user->{host}; my @hd = split m/[\.]/, $user->{host};
shift @hd; shift @hd;
$mask = '*!*@*.'.join ' ', @hd; $mask = '*!*@*.'.join q{ }, @hd;
} }
} }
@@ -46,18 +47,16 @@ sub ban
} }
# Join a channel. # Join a channel.
sub cjoin sub cjoin {
{
my ($svr, $chan, $key) = @_; my ($svr, $chan, $key) = @_;
Auto::socksnd($svr, "JOIN ".((defined $key) ? "$chan $key" : "$chan")); Auto::socksnd($svr, 'JOIN '.((defined $key) ? "$chan $key" : $chan));
return 1; return 1;
} }
# Part a channel. # Part a channel.
sub cpart sub cpart {
{
my ($svr, $chan, $reason) = @_; my ($svr, $chan, $reason) = @_;
if (defined $reason) { if (defined $reason) {
@@ -67,14 +66,11 @@ sub cpart
Auto::socksnd($svr, "PART $chan :Leaving"); Auto::socksnd($svr, "PART $chan :Leaving");
} }
if (defined $Parser::IRC::botchans{$svr}{$chan}) { delete $Parser::IRC::botchans{$svr}{$chan}; }
return 1; return 1;
} }
# Set mode(s) on a channel. # Set mode(s) on a channel.
sub cmode sub cmode {
{
my ($svr, $chan, $modes) = @_; my ($svr, $chan, $modes) = @_;
Auto::socksnd($svr, "MODE $chan $modes"); Auto::socksnd($svr, "MODE $chan $modes");
@@ -83,38 +79,50 @@ sub cmode
} }
# Set mode(s) on us. # Set mode(s) on us.
sub umode sub umode {
{
my ($svr, $modes) = @_; my ($svr, $modes) = @_;
Auto::socksnd($svr, "MODE ".$Parser::IRC::botnick{$svr}{nick}." $modes"); Auto::socksnd($svr, 'MODE '.$State::IRC::botinfo{$svr}{nick}." $modes");
return 1; return 1;
} }
# Send a PRIVMSG. # Send a PRIVMSG.
sub privmsg sub privmsg {
{
my ($svr, $target, $message) = @_; my ($svr, $target, $message) = @_;
Auto::socksnd($svr, "PRIVMSG $target :$message"); # Get maximum length.
my $maxlen = 510 - length q{:}.$State::IRC::botinfo{$svr}{nick}.q{!}.$State::IRC::botinfo{$svr}{user}.q{@}.$State::IRC::botinfo{$svr}{mask}." PRIVMSG $target :";
# Divide message if it surpasses the maximum length.
while (length $message >= $maxlen) {
my $submsg = substr $message, 0, $maxlen, q{};
Auto::socksnd($svr, "PRIVMSG $target :$submsg");
}
if (length $message) { Auto::socksnd($svr, "PRIVMSG $target :$message") }
return 1; return 1;
} }
# Send a NOTICE. # Send a NOTICE.
sub notice sub notice {
{
my ($svr, $target, $message) = @_; my ($svr, $target, $message) = @_;
Auto::socksnd($svr, "NOTICE $target :$message"); # Get maximum length.
my $maxlen = 510 - length q{:}.$State::IRC::botinfo{$svr}{nick}.q{!}.$State::IRC::botinfo{$svr}{user}.q{@}.$State::IRC::botinfo{$svr}{mask}." NOTICE $target :";
# Divide message if it surpasses the maximum length.
while (length $message >= $maxlen) {
my $submsg = substr $message, 0, $maxlen, q{};
Auto::socksnd($svr, "NOTICE $target :$submsg");
}
if (length $message) { Auto::socksnd($svr, "NOTICE $target :$message") }
return 1; return 1;
} }
# Send an ACTION PRIVMSG. # Send an ACTION PRIVMSG.
sub act sub act {
{
my ($svr, $target, $message) = @_; my ($svr, $target, $message) = @_;
Auto::socksnd($svr, "PRIVMSG $target :\001ACTION $message\001"); Auto::socksnd($svr, "PRIVMSG $target :\001ACTION $message\001");
@@ -122,21 +130,31 @@ sub act
return 1; return 1;
} }
# Check if a given nickname is on a channel.
sub ison {
my ($svr, $chan, $nick) = @_;
$chan = lc $chan;
if (!exists $State::IRC::chanusers{$svr}) { return }
if (!exists $State::IRC::chanusers{$svr}{$chan}) { return }
if (!exists $State::IRC::chanusers{$svr}{$chan}{lc $nick}) { return }
return 1;
}
# Change bot nickname. # Change bot nickname.
sub nick sub nick {
{
my ($svr, $newnick) = @_; my ($svr, $newnick) = @_;
Auto::socksnd($svr, "NICK $newnick"); Auto::socksnd($svr, "NICK $newnick");
$Parser::IRC::botnick{$svr}{newnick} = $newnick; $State::IRC::botinfo{$svr}{newnick} = $newnick;
return 1; return 1;
} }
# Request the users of a channel. # Request the users of a channel.
sub names sub names {
{
my ($svr, $chan) = @_; my ($svr, $chan) = @_;
Auto::socksnd($svr, "NAMES $chan"); Auto::socksnd($svr, "NAMES $chan");
@@ -145,8 +163,7 @@ sub names
} }
# Send a topic to the channel. # Send a topic to the channel.
sub topic sub topic {
{
my ($svr, $chan, $topic) = @_; my ($svr, $chan, $topic) = @_;
Auto::socksnd($svr, "TOPIC $chan :$topic"); Auto::socksnd($svr, "TOPIC $chan :$topic");
@@ -155,8 +172,7 @@ sub topic
} }
# Kick a user. # Kick a user.
sub kick sub kick {
{
my ($svr, $chan, $nick, $msg) = @_; my ($svr, $chan, $nick, $msg) = @_;
Auto::socksnd($svr, "KICK $chan $nick :".((defined $msg) ? $msg : 'No reason')); Auto::socksnd($svr, "KICK $chan $nick :".((defined $msg) ? $msg : 'No reason'));
@@ -165,31 +181,46 @@ sub kick
} }
# Quit IRC. # Quit IRC.
sub quit sub quit {
{
my ($svr, $reason) = @_; my ($svr, $reason) = @_;
if (defined $reason) { if (defined $reason) {
Auto::socksnd($svr, "QUIT :$reason"); Auto::socksnd($svr, "QUIT :$reason");
} }
else { else {
Auto::socksnd($svr, "QUIT :Leaving"); Auto::socksnd($svr, 'QUIT :Leaving');
} }
delete $Parser::IRC::got_001{$svr} if (defined $Parser::IRC::got_001{$svr}); # Trigger on_disconnect.
delete $Parser::IRC::botnick{$svr} if (defined $Parser::IRC::botnick{$svr}); API::Std::event_run('on_disconnect', $svr);
return 1; return 1;
} }
# Send a WHO.
sub who {
my ($svr, $nick) = @_;
Auto::socksnd($svr, "WHO $nick");
return 1;
}
# Send a WHOIS.
sub whois {
my ($svr, $nick) = @_;
Auto::socksnd($svr, "WHOIS $nick");
return 1;
}
# Get nick, ident and host from a <nick>!<ident>@<host> # Get nick, ident and host from a <nick>!<ident>@<host>
sub usrc sub usrc {
{
my ($ex) = @_; my ($ex) = @_;
my @si = split('!', $ex); my @si = split m/[!]/xsm, $ex;
my @sii = split('@', $si[1]); my @sii = split m/[@]/xsm, $si[1];
return ( return (
nick => $si[0], nick => $si[0],
@@ -199,24 +230,24 @@ sub usrc
} }
# Match two IRC masks. # Match two IRC masks.
sub match_mask sub match_mask {
{
my ($mu, $mh) = @_; my ($mu, $mh) = @_;
# Prepare the regex. # Prepare the regex.
$mh =~ s/\./\\\./g; $mh =~ s/\./\\\./gxsm;
$mh =~ s/\?/\./g; $mh =~ s/\?/\./gxsm;
$mh =~ s/\*/\.\*/g; $mh =~ s/\*/\.\*/gxsm;
$mh = '^'.$mh.'$'; $mh =~ s/\//\\\//gxsm;
$mh = q{^}.$mh.q{$};
# Let's grep the user's mask. # Let's match the user's mask.
if (grep(/$mh/, $mu)) { if ($mu =~ m/$mh/xsm) {
return 1; return 1;
} }
return 0; return;
} }
1; 1;
# vim: set ai sw=4 ts=4: # vim: set ai et sw=4 ts=4:
+12 -13
View File
@@ -10,7 +10,7 @@ use POSIX;
use Time::Local; use Time::Local;
use Exporter; use Exporter;
use base qw(Exporter); use base qw(Exporter);
use API::Std qw(conf_get); use API::Std qw(conf_get fpfmt);
our @EXPORT_OK = qw(println dbug alog slog); our @EXPORT_OK = qw(println dbug alog slog);
@@ -56,16 +56,12 @@ sub alog
my $time = POSIX::strftime('%Y-%m-%d %I:%M:%S %p', localtime); my $time = POSIX::strftime('%Y-%m-%d %I:%M:%S %p', localtime);
# Create var/ if it doesn't exist. # Create var/ if it doesn't exist.
if (!-d "$Auto::Bin/../var") { if (!-d "$Auto::bin{var}") {
mkdir "$Auto::Bin/../var", 0600; ## no critic qw(ValuesAndExpressions::ProhibitMagicNumbers) mkdir "$Auto::bin{var}", 0600; ## no critic qw(ValuesAndExpressions::ProhibitMagicNumbers)
}
# Create var/DATE.log if it doesn't exist.
if (!-e "$Auto::Bin/../var/$date.log") {
system "touch $Auto::Bin/../var/$date.log";
} }
# Open the logfile, print the log message to it and close it. # Open the logfile, print the log message to it and close it.
open my $FLOG, '>>', "$Auto::Bin/../var/$date.log" or return; open my $FLOG, '>>', "$Auto::bin{var}/$date.log" or return;
print {$FLOG} "[$time] $lmsg\n" or return; print {$FLOG} "[$time] $lmsg\n" or return;
close $FLOG or return; close $FLOG or return;
@@ -89,7 +85,7 @@ sub expire_logs
} }
# Iterate through each logfile. # Iterate through each logfile.
foreach my $file (glob "$Auto::Bin/../var/*") { foreach my $file (glob fpfmt("$Auto::bin{var}/*")) {
my (undef, $file) = split 'bin/../var/', $file; ## no critic qw(BuiltinFunctions::ProhibitStringySplit) my (undef, $file) = split 'bin/../var/', $file; ## no critic qw(BuiltinFunctions::ProhibitStringySplit)
# Convert filename to UNIX time. # Convert filename to UNIX time.
@@ -101,7 +97,7 @@ sub expire_logs
# If it's older than <config_value> days, delete it. # If it's older than <config_value> days, delete it.
if (time - $epoch > 86_400 * $celog) { ## no critic qw(ValuesAndExpressions::ProhibitMagicNumbers) if (time - $epoch > 86_400 * $celog) { ## no critic qw(ValuesAndExpressions::ProhibitMagicNumbers)
unlink "$Auto::Bin/../var/$file"; unlink "$Auto::bin{var}/$file";
} }
} }
@@ -117,8 +113,11 @@ sub slog
if (conf_get('logchan')) { if (conf_get('logchan')) {
# It is, continue. # It is, continue.
# Don't even bother with continuing if there are *NO* connections.
if (!keys %Auto::SOCKET) { return }
# Split the network and channel. # Split the network and channel.
my ($net, $chan) = split '/', (conf_get('logchan'))[0][0]; my ($net, $chan) = split m/[\/]/xsm, (conf_get('logchan'))[0][0];
$chan = lc $chan; $chan = lc $chan;
# Check if we're connected to the network. # Check if we're connected to the network.
@@ -129,7 +128,7 @@ sub slog
} }
# Check if we're in the channel. # Check if we're in the channel.
if (!defined $Parser::IRC::botchans{$net}{$chan}) { if (!defined $Proto::IRC::botchans{$net}{$chan}) {
dbug 'WARNING: slog(): Unable to log to IRC: Not in channel.'; dbug 'WARNING: slog(): Unable to log to IRC: Not in channel.';
alog 'WARNING: slog(): Unable to log to IRC: Not in channel.'; alog 'WARNING: slog(): Unable to log to IRC: Not in channel.';
return; return;
@@ -143,4 +142,4 @@ sub slog
} }
1; 1;
# vim: set ai sw=4 ts=4: # vim: set ai et sw=4 ts=4:
+89 -77
View File
@@ -9,27 +9,27 @@ use Exporter;
use base qw(Exporter); use base qw(Exporter);
our (%LANGE, %MODULE, %EVENTS, %HOOKS, %CMDS); our (%LANGE, %MODULE, %EVENTS, %HOOKS, %CMDS, %ALIASES, %RAWHOOKS);
our @EXPORT_OK = qw(conf_get trans err awarn timer_add timer_del cmd_add our @EXPORT_OK = qw(conf_get trans err awarn timer_add timer_del cmd_add
cmd_del hook_add hook_del rchook_add rchook_del match_user cmd_del hook_add hook_del rchook_add rchook_del match_user
has_priv mod_exists ratelimit_check); has_priv mod_exists ratelimit_check fpfmt);
# Initialize a module. # Initialize a module.
sub mod_init sub mod_init {
{ my ($name, $author, $version, $autover) = @_;
my ($name, $author, $version, $autover, $pkg) = @_; my $pkg = caller 0;
# Log/debug. # Log/debug.
API::Log::dbug('MODULES: Attempting to load '.$name.' (version '.$version.') by '.$author.'...'); API::Log::dbug('MODULES: Attempting to load '.$name.' (version '.$version.') by '.$author.'...');
API::Log::alog('MODULES: Attempting to load '.$name.' (version '.$version.') by '.$author.'...'); API::Log::alog('MODULES: Attempting to load '.$name.' (version '.$version.') by '.$author.'...');
if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Attempting to load '.$name.' (version '.$version.') by '.$author.'...'); } if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Attempting to load '.$name.' (version '.$version.') by '.$author.'...') }
# Check if this module is compatible with this version of Auto. # Check if this module is compatible with this version of Auto.
if ($autover ne '3.0.0a4') { if ($autover !~ m/^3\.0\.0a(7|8|9|10|11)$/xsm) {
API::Log::dbug('MODULES: Failed to load '.$name.': Incompatible with your version of Auto.'); API::Log::dbug('MODULES: Failed to load '.$name.': Incompatible with your version of Auto.');
API::Log::alog('MODULES: Failed to load '.$name.': Incompatible with your version of Auto.'); API::Log::alog('MODULES: Failed to load '.$name.': Incompatible with your version of Auto.');
if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Failed to load '.$name.': Incompatible with your version of Auto.'); } if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Failed to load '.$name.': Incompatible with your version of Auto.') }
return; return;
} }
@@ -45,7 +45,7 @@ sub mod_init
API::Log::dbug('MODULES: '.$name.' successfully loaded.'); API::Log::dbug('MODULES: '.$name.' successfully loaded.');
API::Log::alog('MODULES: '.$name.' successfully loaded.'); API::Log::alog('MODULES: '.$name.' successfully loaded.');
if (keys %Auto::SOCKET) { API::Log::slog('MODULES: '.$name.' successfully loaded.'); } if (keys %Auto::SOCKET) { API::Log::slog('MODULES: '.$name.' successfully loaded.') }
return 1; return 1;
} }
@@ -53,37 +53,37 @@ sub mod_init
# Otherwise, return a failed to load message. # Otherwise, return a failed to load message.
API::Log::dbug('MODULES: Failed to load '.$name.q{.}); API::Log::dbug('MODULES: Failed to load '.$name.q{.});
API::Log::alog('MODULES: Failed to load '.$name.q{.}); API::Log::alog('MODULES: Failed to load '.$name.q{.});
if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Failed to load '.$name.q{.}); } if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Failed to load '.$name.q{.}) }
# Just in case.
Class::Unload->unload($pkg);
return; return;
} }
} }
# Check if a module exists. # Check if a module exists.
sub mod_exists sub mod_exists {
{
my ($name) = @_; my ($name) = @_;
if (defined $API::Std::MODULE{$name}) { return 1; } if (defined $API::Std::MODULE{$name}) { return 1 }
return; return;
} }
# Void a module. # Void a module.
sub mod_void sub mod_void {
{
my ($module) = @_; my ($module) = @_;
# Log/debug. # Log/debug.
API::Log::dbug('MODULES: Attempting to unload module: '.$module.'...'); API::Log::dbug('MODULES: Attempting to unload module: '.$module.'...');
API::Log::alog('MODULES: Attempting to unload module: '.$module.'...'); API::Log::alog('MODULES: Attempting to unload module: '.$module.'...');
if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Attempting to unload module: '.$module.'...'); } if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Attempting to unload module: '.$module.'...') }
# Check if this module exists. # Check if this module exists.
if (!defined $MODULE{$module}) { if (!defined $MODULE{$module}) {
API::Log::dbug('MODULES: Failed to unload '.$module.'. No such module?'); API::Log::dbug('MODULES: Failed to unload '.$module.'. No such module?');
API::Log::alog('MODULES: Failed to unload '.$module.'. No such module?'); API::Log::alog('MODULES: Failed to unload '.$module.'. No such module?');
if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Failed to unload '.$module.'. No such module?'); } if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Failed to unload '.$module.'. No such module?') }
return; return;
} }
@@ -96,39 +96,50 @@ sub mod_void
delete $MODULE{$module}; delete $MODULE{$module};
API::Log::dbug('MODULES: Successfully unloaded '.$module.q{.}); API::Log::dbug('MODULES: Successfully unloaded '.$module.q{.});
API::Log::alog('MODULES: Successfully unloaded '.$module.q{.}); API::Log::alog('MODULES: Successfully unloaded '.$module.q{.});
if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Successfully unloaded '.$module.q{.}); } if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Successfully unloaded '.$module.q{.}) }
return 1; return 1;
} }
else { else {
# Otherwise, return a failed to unload message. # Otherwise, return a failed to unload message.
API::Log::dbug('MODULES: Failed to unload '.$module.q{.}); API::Log::dbug('MODULES: Failed to unload '.$module.q{.});
API::Log::alog('MODULES: Failed to unload '.$module.q{.}); API::Log::alog('MODULES: Failed to unload '.$module.q{.});
if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Failed to unload '.$module.q{.}); } if (keys %Auto::SOCKET) { API::Log::slog('MODULES: Failed to unload '.$module.q{.}) }
return; return;
} }
} }
# Add a command to Auto. # Add a command to Auto.
sub cmd_add sub cmd_add {
{
my ($cmd, $lvl, $priv, $help, $sub) = @_; my ($cmd, $lvl, $priv, $help, $sub) = @_;
$cmd = uc $cmd; $cmd = uc $cmd;
if (defined $API::Std::CMDS{$cmd}) { return; } if (defined $API::Std::CMDS{$cmd}) { return }
if ($lvl =~ m/[^0-2]/sm) { return; } ## no critic qw(RegularExpressions::RequireExtendedFormatting) if ($lvl =~ m/[^0-3]/sm) { return } ## no critic qw(RegularExpressions::RequireExtendedFormatting)
$API::Std::CMDS{$cmd}{lvl} = $lvl; $API::Std::CMDS{$cmd}{lvl} = $lvl;
$API::Std::CMDS{$cmd}{help} = $help; $API::Std::CMDS{$cmd}{help} = $help;
$API::Std::CMDS{$cmd}{priv} = $priv; $API::Std::CMDS{$cmd}{priv} = $priv;
$API::Std::CMDS{$cmd}{sub} = $sub; $API::Std::CMDS{$cmd}{'sub'} = $sub;
return 1; return 1;
} }
# Alias a command to another.
sub cmd_alias {
my ($alias, $cmd) = @_;
# Prepare data.
$alias = uc $alias;
$cmd = uc $cmd;
# Create alias.
$ALIASES{$alias} = $cmd;
return 1;
}
# Delete a command from Auto. # Delete a command from Auto.
sub cmd_del sub cmd_del {
{
my ($cmd) = @_; my ($cmd) = @_;
$cmd = uc $cmd; $cmd = uc $cmd;
@@ -143,8 +154,7 @@ sub cmd_del
} }
# Add an event to Auto. # Add an event to Auto.
sub event_add sub event_add {
{
my ($name) = @_; my ($name) = @_;
if (!defined $EVENTS{lc $name}) { if (!defined $EVENTS{lc $name}) {
@@ -158,8 +168,7 @@ sub event_add
} }
# Delete an event from Auto. # Delete an event from Auto.
sub event_del sub event_del {
{
my ($name) = @_; my ($name) = @_;
if (defined $EVENTS{lc $name}) { if (defined $EVENTS{lc $name}) {
@@ -174,14 +183,13 @@ sub event_del
} }
# Trigger an event. # Trigger an event.
sub event_run sub event_run {
{
my ($event, @args) = @_; my ($event, @args) = @_;
if (defined $EVENTS{lc $event} and defined $HOOKS{lc $event}) { if (defined $EVENTS{lc $event} and defined $HOOKS{lc $event}) {
foreach my $hk (keys %{ $HOOKS{lc $event} }) { foreach my $hk (keys %{ $HOOKS{lc $event} }) {
my $ri = &{ $HOOKS{lc $event}{$hk} }(@args); my $ri = &{ $HOOKS{lc $event}{$hk} }(@args);
if ($ri == -1) { last; } if ($ri == -1) { last }
} }
} }
@@ -189,8 +197,7 @@ sub event_run
} }
# Add a hook to Auto. # Add a hook to Auto.
sub hook_add sub hook_add {
{
my ($event, $name, $sub) = @_; my ($event, $name, $sub) = @_;
if (!defined $API::Std::HOOKS{lc $name}) { if (!defined $API::Std::HOOKS{lc $name}) {
@@ -208,8 +215,7 @@ sub hook_add
} }
# Delete a hook from Auto. # Delete a hook from Auto.
sub hook_del sub hook_del {
{
my ($event, $name) = @_; my ($event, $name) = @_;
if (defined $API::Std::HOOKS{lc $event}{lc $name}) { if (defined $API::Std::HOOKS{lc $event}{lc $name}) {
@@ -222,8 +228,7 @@ sub hook_del
} }
# Add a timer to Auto. # Add a timer to Auto.
sub timer_add sub timer_add {
{
my ($name, $type, $time, $sub) = @_; my ($name, $type, $time, $sub) = @_;
$name = lc $name; $name = lc $name;
@@ -238,7 +243,7 @@ sub timer_add
if (!defined $Auto::TIMERS{$name}) { if (!defined $Auto::TIMERS{$name}) {
$Auto::TIMERS{$name}{type} = $type; $Auto::TIMERS{$name}{type} = $type;
$Auto::TIMERS{$name}{time} = time + $time; $Auto::TIMERS{$name}{time} = time + $time;
if ($type == 2) { $Auto::TIMERS{$name}{secs} = $time; } if ($type == 2) { $Auto::TIMERS{$name}{secs} = $time }
$Auto::TIMERS{$name}{sub} = $sub; $Auto::TIMERS{$name}{sub} = $sub;
return 1; return 1;
} }
@@ -247,8 +252,7 @@ sub timer_add
} }
# Delete a timer from Auto. # Delete a timer from Auto.
sub timer_del sub timer_del {
{
my ($name) = @_; my ($name) = @_;
$name = lc $name; $name = lc $name;
@@ -261,34 +265,37 @@ sub timer_del
} }
# Hook onto a raw command. # Hook onto a raw command.
sub rchook_add sub rchook_add {
{ my ($cmd, $name, $sub) = @_;
my ($cmd, $sub) = @_;
$cmd = uc $cmd; $cmd = uc $cmd;
if (defined $Parser::IRC::RAWC{$cmd}) { return; } # Make sure core doesn't already handle this.
if (defined $Proto::IRC::RAWC{$cmd}) { return }
# If the hook already exists, ignore it.
if (defined $RAWHOOKS{$cmd}{$name}) { return }
$Parser::IRC::RAWC{$cmd} = $sub; # Create the hook.
$RAWHOOKS{$cmd}{$name} = $sub;
return 1; return 1;
} }
# Delete a raw command hook. # Delete a raw command hook.
sub rchook_del sub rchook_del {
{ my ($cmd, $name) = @_;
my ($cmd) = @_;
$cmd = uc $cmd; $cmd = uc $cmd;
if (!defined $Parser::IRC::RAWC{$cmd}) { return; } # Make sure the hook exists.
if (!defined $RAWHOOKS{$cmd}{$name}) { return }
delete $Parser::IRC::RAWC{$cmd}; # Delete it.
delete $RAWHOOKS{$cmd}{$name};
return 1; return 1;
} }
# Configuration value getter. # Configuration value getter.
sub conf_get sub conf_get {
{
my ($value) = @_; my ($value) = @_;
# Create an array out of the value. # Create an array out of the value.
@@ -336,8 +343,7 @@ sub conf_get
} }
# Translation subroutine. # Translation subroutine.
sub trans sub trans {
{
my $id = shift; my $id = shift;
$id =~ s/ /_/gsm; $id =~ s/ /_/gsm;
@@ -351,12 +357,11 @@ sub trans
} }
# Match user subroutine. # Match user subroutine.
sub match_user sub match_user {
{
my (%user) = @_; my (%user) = @_;
# Get data from config. # Get data from config.
if (!conf_get('user')) { return; } if (!conf_get('user')) { return }
my %uhp = conf_get('user'); my %uhp = conf_get('user');
foreach my $userkey (keys %uhp) { foreach my $userkey (keys %uhp) {
@@ -386,15 +391,15 @@ sub match_user
my $svr = $ulhp{net}[0]; my $svr = $ulhp{net}[0];
if (defined $Auto::SOCKET{$svr}) { if (defined $Auto::SOCKET{$svr}) {
if ($ccnm eq 'CURRENT' and defined $user{chan}) { if ($ccnm eq 'CURRENT' and defined $user{chan}) {
if (defined $Parser::IRC::chanusers{$svr}{$user{chan}}{$user{nick}}) { if (defined $State::IRC::chanusers{$svr}{$user{chan}}{$user{nick}}) {
if ($Parser::IRC::chanusers{$svr}{$user{chan}}{$user{nick}} =~ m/($ccst)/sm) { return $userkey; } ## no critic qw(RegularExpressions::RequireExtendedFormatting) if ($State::IRC::chanusers{$svr}{$user{chan}}{$user{nick}} =~ m/($ccst)/sm) { return $userkey } ## no critic qw(RegularExpressions::RequireExtendedFormatting)
} }
} }
else { else {
foreach my $bcj (keys %{ $Parser::IRC::botchans{$svr} }) { foreach my $bcj (keys %{ $Proto::IRC::botchans{$svr} }) {
if (API::IRC::match_mask($bcj, $ccnm)) { if (API::IRC::match_mask($bcj, $ccnm)) {
if (defined $Parser::IRC::chanusers{$svr}{$bcj}{$user{nick}}) { if (defined $State::IRC::chanusers{$svr}{$bcj}{$user{nick}}) {
if ($Parser::IRC::chanusers{$svr}{$bcj}{$user{nick}} =~ m/($ccst)/sm) { return $userkey; } ## no critic qw(RegularExpressions::RequireExtendedFormatting) if ($State::IRC::chanusers{$svr}{$bcj}{$user{nick}} =~ m/($ccst)/sm) { return $userkey } ## no critic qw(RegularExpressions::RequireExtendedFormatting)
} }
} }
} }
@@ -408,8 +413,7 @@ sub match_user
} }
# Privilege subroutine. # Privilege subroutine.
sub has_priv sub has_priv {
{
my ($cuser, $cpriv) = @_; my ($cuser, $cpriv) = @_;
if (conf_get("user:$cuser:privs")) { if (conf_get("user:$cuser:privs")) {
@@ -417,7 +421,7 @@ sub has_priv
if (defined $Auto::PRIVILEGES{$cups}) { if (defined $Auto::PRIVILEGES{$cups}) {
foreach (@{ $Auto::PRIVILEGES{$cups} }) { foreach (@{ $Auto::PRIVILEGES{$cups} }) {
if ($_ eq $cpriv or $_ eq 'ALL') { return 1; } if ($_ eq $cpriv or $_ eq 'ALL') { return 1 }
} }
} }
} }
@@ -426,8 +430,7 @@ sub has_priv
} }
# Ratelimit check subroutine. # Ratelimit check subroutine.
sub ratelimit_check sub ratelimit_check {
{
my (%src) = @_; my (%src) = @_;
# Check if ratelimit is set to on. # Check if ratelimit is set to on.
@@ -445,9 +448,9 @@ sub ratelimit_check
return 1; return 1;
} }
else { else {
# Increment their uses and return 0. # Increment their uses and return false.
$Core::IRC::usercmd{$src{nick}.'@'.$src{host}.'/'.$src{svr}}++; $Core::IRC::usercmd{$src{nick}.'@'.$src{host}.'/'.$src{svr}}++;
return 0; return;
} }
} }
else { else {
@@ -459,8 +462,7 @@ sub ratelimit_check
} }
# Error subroutine. # Error subroutine.
sub err ## no critic qw(Subroutines::ProhibitBuiltinHomonyms) sub err { ## no critic qw(Subroutines::ProhibitBuiltinHomonyms)
{
my ($lvl, $msg, $fatal) = @_; my ($lvl, $msg, $fatal) = @_;
# Check for an invalid level. # Check for an invalid level.
@@ -485,14 +487,16 @@ sub err ## no critic qw(Subroutines::ProhibitBuiltinHomonyms)
} }
# If it's a fatal error, exit the program. # If it's a fatal error, exit the program.
if ($fatal) { exit; } if ($fatal) {
API::Std::event_run('on_shutdown');
exit;
}
return 1; return 1;
} }
# Warn subroutine. # Warn subroutine.
sub awarn sub awarn {
{
my ($lvl, $msg) = @_; my ($lvl, $msg) = @_;
# Check for an invalid level. # Check for an invalid level.
@@ -516,6 +520,14 @@ sub awarn
return 1; return 1;
} }
# Formatting a file path.
sub fpfmt {
my ($path) = @_;
if ($path =~ m/\s/xsm) { return "\"$path\"" }
else { return $path }
}
1; 1;
# vim: set ai sw=4 ts=4: # vim: set ai et sw=4 ts=4:
+44 -17
View File
@@ -21,13 +21,13 @@ sub cmd_modload
# Check for the needed parameters. # Check for the needed parameters.
if (!defined $argv[0]) { if (!defined $argv[0]) {
notice($src->{svr}, $src->{nick}, trans("Not enough parameters")."."); notice($src->{svr}, $src->{nick}, trans("Not enough parameters").".");
return 0; return;
} }
# Check if the module is already loaded. # Check if the module is already loaded.
if (API::Std::mod_exists($argv[0])) { if (API::Std::mod_exists($argv[0])) {
notice($src->{svr}, $src->{nick}, "Module \002".$argv[0]."\002 is already loaded."); notice($src->{svr}, $src->{nick}, "Module \002".$argv[0]."\002 is already loaded.");
return 0; return;
} }
# Go for it! # Go for it!
@@ -41,7 +41,7 @@ sub cmd_modload
else { else {
# We weren't. # We weren't.
notice($src->{svr}, $src->{nick}, "Module \002".$argv[0]."\002 failed to load."); notice($src->{svr}, $src->{nick}, "Module \002".$argv[0]."\002 failed to load.");
return 0; return;
} }
return 1; return 1;
@@ -59,13 +59,13 @@ sub cmd_modunload
# Check for the needed parameters. # Check for the needed parameters.
if (!defined $argv[0]) { if (!defined $argv[0]) {
notice($src->{svr}, $src->{nick}, trans("Not enough parameters")."."); notice($src->{svr}, $src->{nick}, trans("Not enough parameters").".");
return 0; return;
} }
# Check if the module exists. # Check if the module exists.
if (!API::Std::mod_exists($argv[0])) { if (!API::Std::mod_exists($argv[0])) {
notice($src->{svr}, $src->{nick}, "Module \002".$argv[0]."\002 is not loaded."); notice($src->{svr}, $src->{nick}, "Module \002".$argv[0]."\002 is not loaded.");
return 0; return;
} }
# Go for it! # Go for it!
@@ -79,7 +79,7 @@ sub cmd_modunload
else { else {
# We weren't. # We weren't.
notice($src->{svr}, $src->{nick}, "Module \002".$argv[0]."\002 failed to unload."); notice($src->{svr}, $src->{nick}, "Module \002".$argv[0]."\002 failed to unload.");
return 0; return;
} }
return 1; return 1;
@@ -97,13 +97,13 @@ sub cmd_modreload
# Check for the needed parameters. # Check for the needed parameters.
if (!defined $argv[0]) { if (!defined $argv[0]) {
notice($src->{svr}, $src->{nick}, trans("Not enough parameters")."."); notice($src->{svr}, $src->{nick}, trans("Not enough parameters").".");
return 0; return;
} }
# Check if the module exists. # Check if the module exists.
if (!API::Std::mod_exists($argv[0])) { if (!API::Std::mod_exists($argv[0])) {
notice($src->{svr}, $src->{nick}, "Module \002".$argv[0]."\002 is not loaded."); notice($src->{svr}, $src->{nick}, "Module \002".$argv[0]."\002 is not loaded.");
return 0; return;
} }
# Go for it! # Go for it!
@@ -119,15 +119,37 @@ sub cmd_modreload
else { else {
# We weren't. # We weren't.
notice($src->{svr}, $src->{nick}, "Module \002".$argv[0]."\002 failed to reload."); notice($src->{svr}, $src->{nick}, "Module \002".$argv[0]."\002 failed to reload.");
return 0; return;
} }
return 1; return 1;
} }
# Help hash for MODLIST. Spanish, French and German needed.
our %HELP_MODLIST = (
'en' => "This will return a list of all currently loaded modules. \2Syntax:\2 MODLIST",
);
# MODLIST callback.
sub cmd_modlist
{
my ($src, undef) = @_;
# Iterate through all loaded modules.
my $str;
foreach (keys %API::Std::MODULE) {
$str .= ", \2$_\2 (v".$API::Std::MODULE{$_}{version}.')';
}
# Return it.
$str = substr $str, 2;
notice($src->{svr}, $src->{nick}, "\2Module List:\2 $str");
return 1;
}
# Help hash for SHUTDOWN. Spanish, French and German needed. # Help hash for SHUTDOWN. Spanish, French and German needed.
our %HELP_SHUTDOWN = ( our %HELP_SHUTDOWN = (
'en' => 'This will send out shutdown notifications, quit all networks, flush the database then exit the program.', 'en' => "This will send out shutdown notifications, quit all networks, flush the database then exit the program. \2Syntax:\2 SHUTDOWN",
); );
# SHUTDOWN callback. # SHUTDOWN callback.
sub cmd_shutdown sub cmd_shutdown
@@ -164,10 +186,10 @@ sub cmd_restart
# Time to come back from the dead! # Time to come back from the dead!
if ($Auto::DEBUG) { if ($Auto::DEBUG) {
system("$Auto::Bin/auto -d -nuc"); exec "perl $Auto::Bin/auto -d -nuc";
} }
else { else {
system("$Auto::Bin/auto -nuc"); exec "perl $Auto::Bin/auto -nuc";
} }
exit; exit;
@@ -243,9 +265,9 @@ sub cmd_help
# Help for a specific command was requested. Lets get it. # Help for a specific command was requested. Lets get it.
my $rcm = uc($argv[0]); my $rcm = uc($argv[0]);
if (defined $API::Std::CMDS{$rcm}{help}) {
# If there is help for this command. # If there is help for this command.
if (exists $API::Std::CMDS{$rcm}) {
if (exists $API::Std::CMDS{$rcm}{help}) {
# Check for necessary privileges. # Check for necessary privileges.
if ($API::Std::CMDS{$rcm}{priv}) { if ($API::Std::CMDS{$rcm}{priv}) {
if (!has_priv(match_user(%$src), $API::Std::CMDS{$rcm}{priv})) { if (!has_priv(match_user(%$src), $API::Std::CMDS{$rcm}{priv})) {
@@ -260,13 +282,13 @@ sub cmd_help
# Get the language. # Get the language.
my ($lang, undef) = split('_', $Auto::LOCALE); my ($lang, undef) = split('_', $Auto::LOCALE);
if (defined ${ $API::Std::CMDS{$rcm}{help} }{$lang}) { if (exists ${ $API::Std::CMDS{$rcm}{help} }{$lang}) {
# If help for this command is available in the configured language. # If help for this command is available in the configured language.
notice($src->{svr}, $src->{nick}, "Help for \002".$rcm."\002: ".${ $API::Std::CMDS{$rcm}{help} }{$lang}); notice($src->{svr}, $src->{nick}, "Help for \002".$rcm."\002: ".${ $API::Std::CMDS{$rcm}{help} }{$lang});
} }
else { else {
# If it isn't, default to English. # If it isn't, default to English.
if (defined ${ $API::Std::CMDS{$rcm}{help} }{en}) { if (exists ${ $API::Std::CMDS{$rcm}{help} }{en}) {
# If help for this command is available in English. # If help for this command is available in English.
notice($src->{svr}, $src->{nick}, "Help for \002".$rcm."\002: ".${ $API::Std::CMDS{$rcm}{help} }{en}); notice($src->{svr}, $src->{nick}, "Help for \002".$rcm."\002: ".${ $API::Std::CMDS{$rcm}{help} }{en});
} }
@@ -286,10 +308,15 @@ sub cmd_help
notice($src->{svr}, $src->{nick}, "No help for \002".$rcm."\002 available."); notice($src->{svr}, $src->{nick}, "No help for \002".$rcm."\002 available.");
} }
} }
else {
# If there is no help, don't give any.
notice($src->{svr}, $src->{nick}, "No help for \002".$rcm."\002 available.");
}
}
return 1; return 1;
} }
1; 1;
# vim: set ai sw=4 ts=4: # vim: set ai et sw=4 ts=4:
+173 -7
View File
@@ -19,21 +19,85 @@ hook_add("on_uprivmsg", "ctcp_version_reply", sub {
notice($src->{svr}, $src->{nick}, "\001VERSION ".Auto::NAME." ".Auto::VER.".".Auto::SVER.".".Auto::REV.Auto::RSTAGE." ".$OSNAME."\001"); notice($src->{svr}, $src->{nick}, "\001VERSION ".Auto::NAME." ".Auto::VER.".".Auto::SVER.".".Auto::REV.Auto::RSTAGE." ".$OSNAME."\001");
} }
else { else {
notice($src->{svr}, $src->{nick}, "\001VERSION ".Auto::NAME." ".Auto::VER.".".Auto::SVER.".".Auto::REV.Auto::RSTAGE."-".Auto::GR." ".$OSNAME."\001"); notice($src->{svr}, $src->{nick}, "\001VERSION ".Auto::NAME." ".Auto::VER.".".Auto::SVER.".".Auto::REV.Auto::RSTAGE."-$Auto::VERGITREV ".$OSNAME."\001");
} }
} }
return 1; return 1;
}); });
# Command alias parsing for channel messages.
hook_add('on_cprivmsg', 'irc.commands.aliases', sub {
my (($src, $chan, ($cmd, @args))) = @_;
# Check for valid length.
if (length $cmd >= 2) {
my $ipref = substr $cmd, 0, 1, q{};
my $upref = (conf_get('fantasy_pf'))[0][0];
# Check if the prefix is valid.
if ($upref eq $ipref) {
# It is, check for an alias.
if (defined $API::Std::ALIASES{uc $cmd}) {
# Get aliased command.
my @actual;
if ($API::Std::ALIASES{uc $cmd} =~ m/ /xsm) { @actual = split /\s/xsm, $API::Std::ALIASES{uc $cmd} }
else { @actual = ($API::Std::ALIASES{uc $cmd}) }
# Prepare data.
my @msg = (
q{:}.$src->{nick}.q{!}.$src->{user}.q{@}.$src->{host},
'PRIVMSG',
$chan,
q{:}.$upref.$actual[0],
);
# Rest of the data.
if (scalar @actual > 1) { for (1..$#actual) { push @msg, $actual[$_] } }
if (defined $args[0]) { foreach (@args) { push @msg, $_ } }
# Simulate a PRIVMSG.
Proto::IRC::privmsg($src->{svr}, @msg);
}
}
}
return 1;
});
# Command alias parsing for private messages.
hook_add('on_uprivmsg', 'irc.commands.aliases', sub {
my (($src, ($cmd, @args))) = @_;
my $cprefix = (conf_get('fantasy_pf'))[0][0];
if (substr($cmd, 0, 1) eq $cprefix) { $cmd = substr $cmd, 1 }
# Check for an alias.
if (defined $API::Std::ALIASES{uc $cmd}) {
# Get aliased command.
my @actual;
if ($API::Std::ALIASES{uc $cmd} =~ m/ /xsm) { @actual = split /\s/xsm, $API::Std::ALIASES{uc $cmd} }
else { @actual = ($API::Std::ALIASES{uc $cmd}) }
# Prepare data.
my @msg = (
q{:}.$src->{nick}.q{!}.$src->{user}.q{@}.$src->{host},
'PRIVMSG',
$State::IRC::botinfo{$src->{svr}}{nick},
q{:}.$actual[0],
);
# Rest of the data.
if (scalar @actual > 1) { for (1..$#actual) { push @msg, $actual[$_] } }
if (defined $args[0]) { foreach (@args) { push @msg, $_ } }
# Simulate a PRIVMSG.
Proto::IRC::privmsg($src->{svr}, @msg);
}
return 1;
});
# QUIT hook; delete user from chanusers. # QUIT hook; delete user from chanusers.
hook_add("on_quit", "quit_update_chanusers", sub { hook_add("on_quit", "quit_update_chanusers", sub {
my (($svr, $src, undef)) = @_; my (($src, undef)) = @_;
my %src = %{ $src }; my %src = %{ $src };
# Delete the user from all channels. # Delete the user from all channels.
foreach my $ccu (keys %{ $Parser::IRC::chanusers{$svr} }) { foreach my $ccu (keys %{ $State::IRC::chanusers{$src{svr}}}) {
if (defined $Parser::IRC::chanusers{$svr}{$ccu}{$src{nick}}) { delete $Parser::IRC::chanusers{$svr}{$ccu}{$src{nick}}; } if (defined $State::IRC::chanusers{$src{svr}}{$ccu}{lc $src{nick}}) { delete $State::IRC::chanusers{$src{svr}}{$ccu}{lc $src{nick}} }
} }
return 1; return 1;
@@ -51,6 +115,15 @@ hook_add("on_connect", "on_connect_modes", sub {
return 1; return 1;
}); });
# Self-WHO on connect.
hook_add('on_connect', 'on_connect_selfwho', sub {
my ($svr) = @_;
API::IRC::who($svr, $State::IRC::botinfo{$svr}{nick});
return 1;
});
# Plaintext auth. # Plaintext auth.
hook_add("on_connect", "plaintext_auth", sub { hook_add("on_connect", "plaintext_auth", sub {
my ($svr) = @_; my ($svr) = @_;
@@ -114,8 +187,55 @@ hook_add("on_connect", "autojoin", sub {
return 1; return 1;
}); });
sub clear_usercmd_timer # WHO reply.
{ hook_add('on_whoreply', 'selfwho.getdata', sub {
my (($svr, $nick, undef, $user, $mask, undef, undef, undef, undef)) = @_;
# Check if it's for us.
if ($nick eq $State::IRC::botinfo{$svr}{nick}) {
# It is. Set data.
$State::IRC::botinfo{$svr}{user} = $user;
$State::IRC::botinfo{$svr}{mask} = $mask;
}
return 1;
});
# ISUPPORT - Set prefixes and channel modes.
hook_add('on_isupport', 'core.prefixchanmode.getdata', sub {
my (($svr, @ex)) = @_;
# Find PREFIX and CHANMODES.
foreach my $ex (@ex) {
if ($ex =~ m/^PREFIX/xsm) {
# Found PREFIX.
my $rpx = substr($ex, 8);
my ($pm, $pp) = split('\)', $rpx);
my @apm = split(//, $pm);
my @app = split(//, $pp);
foreach my $ppm (@apm) {
# Store data.
$Proto::IRC::csprefix{$svr}{$ppm} = shift(@app);
}
}
elsif ($ex =~ m/^CHANMODES/xsm) {
# Found CHANMODES.
my ($mtl, $mtp, $mtpp, $mts) = split m/[,]/xsm, substr($ex, 10);
# List modes.
foreach (split(//, $mtl)) { $Proto::IRC::chanmodes{$svr}{$_} = 1 }
# Modes with parameter.
foreach (split(//, $mtp)) { $Proto::IRC::chanmodes{$svr}{$_} = 2 }
# Modes with parameter when +.
foreach (split(//, $mtpp)) { $Proto::IRC::chanmodes{$svr}{$_} = 3 }
# Modes without parameter.
foreach (split(//, $mts)) { $Proto::IRC::chanmodes{$svr}{$_} = 4 }
}
}
return 1;
});
sub clear_usercmd_timer {
# If ratelimit is set to 1 in config, add this timer. # If ratelimit is set to 1 in config, add this timer.
if ((conf_get('ratelimit'))[0][0] eq 1) { if ((conf_get('ratelimit'))[0][0] eq 1) {
# Clear usercmd hash every X seconds. # Clear usercmd hash every X seconds.
@@ -131,6 +251,52 @@ sub clear_usercmd_timer
return 1; return 1;
} }
# Server data deletion on disconnect.
hook_add('on_disconnect', 'core.irc.deldata', sub {
my ($svr) = @_;
# Delete all data related to the server.
if (defined $Proto::IRC::got_001{$svr}) { delete $Proto::IRC::got_001{$svr} }
if (defined $State::IRC::botinfo{$svr}) { delete $State::IRC::botinfo{$svr} }
if (defined $Proto::IRC::botchans{$svr}) { delete $Proto::IRC::botchans{$svr} }
if (defined $State::IRC::chanusers{$svr}) { delete $State::IRC::chanusers{$svr} }
if (defined $Proto::IRC::csprefix{$svr}) { delete $Proto::IRC::csprefix{$svr} }
if (defined $Proto::IRC::chanmodes{$svr}) { delete $Proto::IRC::chanmodes{$svr} }
if (defined $Proto::IRC::cap{$svr}) { delete $Proto::IRC::cap{$svr} }
return 1;
});
# Track our usermodes.
hook_add('on_umode', 'core.irc.state.umode', sub {
my (($svr, $modes)) = @_;
# Remove anything after a space.
$modes =~ s/(\s.*)//xsm;
# Split the modes.
my @modes = split //, $modes;
# Set operator to 1.
my $op = 1;
# Iterate through the modes.
foreach (@modes) {
if ($_ eq '-') { $op = 0 }
elsif ($_ eq '+') { $op = 1 }
else {
# Adjust our modes.
if ($op) {
$State::IRC::botinfo{$svr}{modes} .= $_;
}
else {
$State::IRC::botinfo{$svr}{modes} =~ s/($_)//xsm;
}
}
}
return 1;
});
1; 1;
# vim: set ai sw=4 ts=4: # vim: set ai et sw=4 ts=4:
+126
View File
@@ -0,0 +1,126 @@
# lib/Core/IRC/Users.pm - IRC user tracking.
# Copyright (C) 2010-2011 Xelhua Development Group, et al.
# This program is free software; rights to this code are stated in doc/LICENSE.
package Core::IRC::Users;
use strict;
use warnings;
use API::Std qw(hook_add);
our %users;
# Initialize the ircusers_create and ircusers_delete events.
API::Std::event_add('ircusers_create');
API::Std::event_add('ircusers_delete');
# Create the on_rcjoin hook.
hook_add('on_rcjoin', 'ircusers.onjoin', sub {
my ($src, $chan) = @_;
# Add the user to the users hash, if not already defined.
if (!$users{$src->{svr}}{lc $src->{nick}}) {
$users{$src->{svr}}{lc $src->{nick}} = $src->{nick};
API::Std::event_run('ircusers_create', ($src->{svr}, $src->{nick}));
}
return 1;
});
# Create the on_namesreply hook.
hook_add('on_namesreply', 'ircusers.names', sub {
my ($svr, $chan, undef) = @_;
# WHO the channel.
API::IRC::who($svr, $chan);
return 1;
});
# Create the on_whoreply hook.
hook_add('on_whoreply', 'ircusers.who', sub {
my ($svr, $nick, undef) = @_;
# Ensure it is not us.
if (lc $nick ne lc $State::IRC::botinfo{$svr}{nick}) {
# It is not. Check if they're already in the users hash.
if (!$users{$svr}{lc $nick}) {
# They are not; add them.
$users{$svr}{lc $nick} = $nick;
}
}
return 1;
});
# Create the on_nick hook.
hook_add('on_nick', 'ircusers.onnick', sub {
my ($src, $newnick) = @_;
# Modify the user's entry in the users hash.
if ($users{$src->{svr}}{lc $src->{nick}}) {
$users{$src->{svr}}{lc $newnick} = $newnick;
delete $users{$src->{svr}}{lc $src->{nick}};
}
return 1;
});
# Create the on_kick hook.
hook_add('on_kick', 'ircusers.onkick', sub {
my ($src, $kchan, $user, undef) = @_;
# Ensure there is a users hash entry for this user.
if ($users{$src->{svr}}{lc $user}) {
# Figure out if the user is in any other channel we're in.
my $ri = 0;
foreach my $chan (keys %{$State::IRC::chanusers{$src->{svr}}}) {
if ($chan ne $kchan) {
if (defined $State::IRC::chanusers{$src->{svr}}{$chan}{lc $user}) { $ri++; last }
}
}
if (!$ri) {
# They are not, delete them.
delete $users{$src->{svr}}{lc $user};
API::Std::event_run('ircusers_delete', ($src->{svr}, $user));
}
}
return 1;
});
# Create the on_part hook.
hook_add('on_part', 'ircusers.onpart', sub {
my ($src, $pchan, undef) = @_;
# Ensure there is a users hash entry for this user.
if ($users{$src->{svr}}{lc $src->{nick}}) {
# Figure out if the user is in any other channel we're in.
my $ri = 0;
foreach my $chan (keys %{$State::IRC::chanusers{$src->{svr}}}) {
if ($chan ne $pchan) {
if (defined $State::IRC::chanusers{$src->{svr}}{$chan}{lc $src->{nick}}) { $ri++; last }
}
}
if (!$ri) {
# They are not, delete them.
delete $users{$src->{svr}}{lc $src->{nick}};
API::Std::event_run('ircusers_delete', ($src->{svr}, $src->{nick}));
}
}
return 1;
});
# Create the on_quit hook.
hook_add('on_quit', 'ircusers.onquit', sub {
my ($src, undef) = @_;
# Delete the user's entry from the users hash.
if ($users{$src->{svr}}{lc $src->{nick}}) {
delete $users{$src->{svr}}{lc $src->{nick}};
}
return 1;
});
1;
# vim: set ai et sw=4 ts=4:
+708
View File
@@ -0,0 +1,708 @@
package File::Copy::Recursive;
use strict;
BEGIN {
# Keep older versions of Perl from trying to use lexical warnings
$INC{'warnings.pm'} = "fake warnings entry for < 5.6 perl ($])" if $] < 5.006;
}
use warnings;
use Carp;
use File::Copy;
use File::Spec; #not really needed because File::Copy already gets it, but for good measure :)
use vars qw(
@ISA @EXPORT_OK $VERSION $MaxDepth $KeepMode $CPRFComp $CopyLink
$PFSCheck $RemvBase $NoFtlPth $ForcePth $CopyLoop $RMTrgFil $RMTrgDir
$CondCopy $BdTrgWrn $SkipFlop $DirPerms
);
require Exporter;
@ISA = qw(Exporter);
@EXPORT_OK = qw(fcopy rcopy dircopy fmove rmove dirmove pathmk pathrm pathempty pathrmdir);
$VERSION = '0.38';
$MaxDepth = 0;
$KeepMode = 1;
$CPRFComp = 0;
$CopyLink = eval { local $SIG{'__DIE__'};symlink '',''; 1 } || 0;
$PFSCheck = 1;
$RemvBase = 0;
$NoFtlPth = 0;
$ForcePth = 0;
$CopyLoop = 0;
$RMTrgFil = 0;
$RMTrgDir = 0;
$CondCopy = {};
$BdTrgWrn = 0;
$SkipFlop = 0;
$DirPerms = 0777;
my $samecheck = sub {
return 1 if $^O eq 'MSWin32'; # need better way to check for this on winders...
return if @_ != 2 || !defined $_[0] || !defined $_[1];
return if $_[0] eq $_[1];
my $one = '';
if($PFSCheck) {
$one = join( '-', ( stat $_[0] )[0,1] ) || '';
my $two = join( '-', ( stat $_[1] )[0,1] ) || '';
if ( $one eq $two && $one ) {
carp "$_[0] and $_[1] are identical";
return;
}
}
if(-d $_[0] && !$CopyLoop) {
$one = join( '-', ( stat $_[0] )[0,1] ) if !$one;
my $abs = File::Spec->rel2abs($_[1]);
my @pth = File::Spec->splitdir( $abs );
while(@pth) {
my $cur = File::Spec->catdir(@pth);
last if !$cur; # probably not necessary, but nice to have just in case :)
my $two = join( '-', ( stat $cur )[0,1] ) || '';
if ( $one eq $two && $one ) {
# $! = 62; # Too many levels of symbolic links
carp "Caught Deep Recursion Condition: $_[0] contains $_[1]";
return;
}
pop @pth;
}
}
return 1;
};
my $glob = sub {
my ($do, $src_glob, @args) = @_;
local $CPRFComp = 1;
my @rt;
for my $path ( glob($src_glob) ) {
my @call = [$do->($path, @args)] or return;
push @rt, \@call;
}
return @rt;
};
my $move = sub {
my $fl = shift;
my @x;
if($fl) {
@x = fcopy(@_) or return;
} else {
@x = dircopy(@_) or return;
}
if(@x) {
if($fl) {
unlink $_[0] or return;
} else {
pathrmdir($_[0]) or return;
}
if($RemvBase) {
my ($volm, $path) = File::Spec->splitpath($_[0]);
pathrm(File::Spec->catpath($volm,$path,''), $ForcePth, $NoFtlPth) or return;
}
}
return wantarray ? @x : $x[0];
};
my $ok_todo_asper_condcopy = sub {
my $org = shift;
my $copy = 1;
if(exists $CondCopy->{$org}) {
if($CondCopy->{$org}{'md5'}) {
}
if($copy) {
}
}
return $copy;
};
sub fcopy {
$samecheck->(@_) or return;
if($RMTrgFil && (-d $_[1] || -e $_[1]) ) {
my $trg = $_[1];
if( -d $trg ) {
my @trgx = File::Spec->splitpath( $_[0] );
$trg = File::Spec->catfile( $_[1], $trgx[ $#trgx ] );
}
$samecheck->($_[0], $trg) or return;
if(-e $trg) {
if($RMTrgFil == 1) {
unlink $trg or carp "\$RMTrgFil failed: $!";
} else {
unlink $trg or return;
}
}
}
my ($volm, $path) = File::Spec->splitpath($_[1]);
if($path && !-d $path) {
pathmk(File::Spec->catpath($volm,$path,''), $NoFtlPth);
}
if( -l $_[0] && $CopyLink ) {
carp "Copying a symlink ($_[0]) whose target does not exist"
if !-e readlink($_[0]) && $BdTrgWrn;
symlink readlink(shift()), shift() or return;
} else {
copy(@_) or return;
my @base_file = File::Spec->splitpath($_[0]);
my $mode_trg = -d $_[1] ? File::Spec->catfile($_[1], $base_file[ $#base_file ]) : $_[1];
chmod scalar((stat($_[0]))[2]), $mode_trg if $KeepMode;
}
return wantarray ? (1,0,0) : 1; # use 0's incase they do math on them and in case rcopy() is called in list context = no uninit val warnings
}
sub rcopy {
if (-l $_[0] && $CopyLink) {
goto &fcopy;
}
goto &dircopy if -d $_[0] || substr( $_[0], ( 1 * -1), 1) eq '*';
goto &fcopy;
}
sub rcopy_glob {
$glob->(\&rcopy, @_);
}
sub dircopy {
if($RMTrgDir && -d $_[1]) {
if($RMTrgDir == 1) {
pathrmdir($_[1]) or carp "\$RMTrgDir failed: $!";
} else {
pathrmdir($_[1]) or return;
}
}
my $globstar = 0;
my $_zero = $_[0];
my $_one = $_[1];
if ( substr( $_zero, ( 1 * -1 ), 1 ) eq '*') {
$globstar = 1;
$_zero = substr( $_zero, 0, ( length( $_zero ) - 1 ) );
}
$samecheck->( $_zero, $_[1] ) or return;
if ( !-d $_zero || ( -e $_[1] && !-d $_[1] ) ) {
$! = 20;
return;
}
if(!-d $_[1]) {
pathmk($_[1], $NoFtlPth) or return;
} else {
if($CPRFComp && !$globstar) {
my @parts = File::Spec->splitdir($_zero);
while($parts[ $#parts ] eq '') { pop @parts; }
$_one = File::Spec->catdir($_[1], $parts[$#parts]);
}
}
my $baseend = $_one;
my $level = 0;
my $filen = 0;
my $dirn = 0;
my $recurs; #must be my()ed before sub {} since it calls itself
$recurs = sub {
my ($str,$end,$buf) = @_;
$filen++ if $end eq $baseend;
$dirn++ if $end eq $baseend;
$DirPerms = oct($DirPerms) if substr($DirPerms,0,1) eq '0';
mkdir($end,$DirPerms) or return if !-d $end;
chmod scalar((stat($str))[2]), $end if $KeepMode;
if($MaxDepth && $MaxDepth =~ m/^\d+$/ && $level >= $MaxDepth) {
return ($filen,$dirn,$level) if wantarray;
return $filen;
}
$level++;
my @files;
if ( $] < 5.006 ) {
opendir(STR_DH, $str) or return;
@files = grep( $_ ne '.' && $_ ne '..', readdir(STR_DH));
closedir STR_DH;
}
else {
opendir(my $str_dh, $str) or return;
@files = grep( $_ ne '.' && $_ ne '..', readdir($str_dh));
closedir $str_dh;
}
for my $file (@files) {
my ($file_ut) = $file =~ m{ (.*) }xms;
my $org = File::Spec->catfile($str, $file_ut);
my $new = File::Spec->catfile($end, $file_ut);
if( -l $org && $CopyLink ) {
carp "Copying a symlink ($org) whose target does not exist"
if !-e readlink($org) && $BdTrgWrn;
symlink readlink($org), $new or return;
}
elsif(-d $org) {
$recurs->($org,$new,$buf) if defined $buf;
$recurs->($org,$new) if !defined $buf;
$filen++;
$dirn++;
}
else {
if($ok_todo_asper_condcopy->($org)) {
if($SkipFlop) {
fcopy($org,$new,$buf) or next if defined $buf;
fcopy($org,$new) or next if !defined $buf;
}
else {
fcopy($org,$new,$buf) or return if defined $buf;
fcopy($org,$new) or return if !defined $buf;
}
chmod scalar((stat($org))[2]), $new if $KeepMode;
$filen++;
}
}
}
1;
};
$recurs->($_zero, $_one, $_[2]) or return;
return wantarray ? ($filen,$dirn,$level) : $filen;
}
sub fmove { $move->(1, @_) }
sub rmove {
if (-l $_[0] && $CopyLink) {
goto &fmove;
}
goto &dirmove if -d $_[0] || substr( $_[0], ( 1 * -1), 1) eq '*';
goto &fmove;
}
sub rmove_glob {
$glob->(\&rmove, @_);
}
sub dirmove { $move->(0, @_) }
sub pathmk {
my @parts = File::Spec->splitdir( shift() );
my $nofatal = shift;
my $pth = $parts[0];
my $zer = 0;
if(!$pth) {
$pth = File::Spec->catdir($parts[0],$parts[1]);
$zer = 1;
}
for($zer..$#parts) {
$DirPerms = oct($DirPerms) if substr($DirPerms,0,1) eq '0';
mkdir($pth,$DirPerms) or return if !-d $pth && !$nofatal;
mkdir($pth,$DirPerms) if !-d $pth && $nofatal;
$pth = File::Spec->catdir($pth, $parts[$_ + 1]) unless $_ == $#parts;
}
1;
}
sub pathempty {
my $pth = shift;
return 2 if !-d $pth;
my @names;
my $pth_dh;
if ( $] < 5.006 ) {
opendir(PTH_DH, $pth) or return;
@names = grep !/^\.+$/, readdir(PTH_DH);
}
else {
opendir($pth_dh, $pth) or return;
@names = grep !/^\.+$/, readdir($pth_dh);
}
for my $name (@names) {
my ($name_ut) = $name =~ m{ (.*) }xms;
my $flpth = File::Spec->catdir($pth, $name_ut);
if( -l $flpth ) {
unlink $flpth or return;
}
elsif(-d $flpth) {
pathrmdir($flpth) or return;
}
else {
unlink $flpth or return;
}
}
if ( $] < 5.006 ) {
closedir PTH_DH;
}
else {
closedir $pth_dh;
}
1;
}
sub pathrm {
my $path = shift;
return 2 if !-d $path;
my @pth = File::Spec->splitdir( $path );
my $force = shift;
while(@pth) {
my $cur = File::Spec->catdir(@pth);
last if !$cur; # necessary ???
if(!shift()) {
pathempty($cur) or return if $force;
rmdir $cur or return;
}
else {
pathempty($cur) if $force;
rmdir $cur;
}
pop @pth;
}
1;
}
sub pathrmdir {
my $dir = shift;
if( -e $dir ) {
return if !-d $dir;
}
else {
return 2;
}
pathempty($dir) or return;
rmdir $dir or return;
}
1;
__END__
=head1 NAME
File::Copy::Recursive - Perl extension for recursively copying files and directories
=head1 SYNOPSIS
use File::Copy::Recursive qw(fcopy rcopy dircopy fmove rmove dirmove);
fcopy($orig,$new[,$buf]) or die $!;
rcopy($orig,$new[,$buf]) or die $!;
dircopy($orig,$new[,$buf]) or die $!;
fmove($orig,$new[,$buf]) or die $!;
rmove($orig,$new[,$buf]) or die $!;
dirmove($orig,$new[,$buf]) or die $!;
rcopy_glob("orig/stuff-*", $trg [, $buf]) or die $!;
rmove_glob("orig/stuff-*", $trg [,$buf]) or die $!;
=head1 DESCRIPTION
This module copies and moves directories recursively (or single files, well... singley) to an optional depth and attempts to preserve each file or directory's
mode.
=head1 EXPORT
None by default. But you can export all the functions as in the example above and the path* functions if you wish.
=head2 fcopy()
This function uses File::Copy's copy() function to copy a file but not a directory. Any directories are recursively created if need be.
One difference to File::Copy::copy() is that fcopy attempts to preserve the mode (see Preserving Mode below)
The optional $buf in the synopsis if the same as File::Copy::copy()'s 3rd argument
returns the same as File::Copy::copy() in scalar context and 1,0,0 in list context to accomidate rcopy()'s list context on regular files. (See below for more
info)
=head2 dircopy()
This function recursively traverses the $orig directory's structure and recursively copies it to the $new directory.
$new is created if necessary (multiple non existant directories is ok (IE foo/bar/baz). The script logically and portably creates all of them if necessary).
It attempts to preserve the mode (see Preserving Mode below) and
by default it copies all the way down into the directory, (see Managing Depth) below.
If a directory is not specified it croaks just like fcopy croaks if its not a file that is specified.
returns true or false, for true in scalar context it returns the number of files and directories copied,
In list context it returns the number of files and directories, number of directories only, depth level traversed.
my $num_of_files_and_dirs = dircopy($orig,$new);
my($num_of_files_and_dirs,$num_of_dirs,$depth_traversed) = dircopy($orig,$new);
Normally it stops and return's if a copy fails, to continue on regardless set $File::Copy::Recursive::SkipFlop to true.
local $File::Copy::Recursive::SkipFlop = 1;
That way it will copy everythgingit can ina directory and won't stop because of permissions, etc...
=head2 rcopy()
This function will allow you to specify a file *or* directory. It calls fcopy() if its a file and dircopy() if its a directory.
If you call rcopy() (or fcopy() for that matter) on a file in list context, the values will be 1,0,0 since no directories and no depth are used.
This is important becasue if its a directory in list context and there is only the initial directory the return value is 1,1,1.
=head2 rcopy_glob()
This function lets you specify a pattern suitable for perl's glob() as the first argument. Subsequently each path returned by perl's glob() gets rcopy()ied.
It returns and array whose items are array refs that contain the return value of each rcopy() call.
It forces behavior as if $File::Copy::Recursive::CPRFComp is true.
=head2 fmove()
Copies the file then removes the original. You can manage the path the original file is in according to $RemvBase.
=head2 dirmove()
Uses dircopy() to copy the directory then removes the original. You can manage the path the original directory is in according to $RemvBase.
=head2 rmove()
Like rcopy() but calls fmove() or dirmove() instead.
=head2 rmove_glob()
Like rcopy_glob() but calls rmove() instead of rcopy()
=head3 $RemvBase
Default is false. When set to true the *move() functions will not only attempt to remove the original file or directory but will remove the given path it is in.
So if you:
rmove('foo/bar/baz', '/etc/');
# "baz" is removed from foo/bar after it is successfully copied to /etc/
local $File::Copy::Recursive::Remvbase = 1;
rmove('foo/bar/baz','/etc/');
# if baz is successfully copied to /etc/ :
# first "baz" is removed from foo/bar
# then "foo/bar is removed via pathrm()
=head4 $ForcePth
Default is false. When set to true it calls pathempty() before any directories are removed to empty the directory so it can be rmdir()'ed when $RemvBase is in
effect.
=head2 Creating and Removing Paths
=head3 $NoFtlPth
Default is false. If set to true rmdir(), mkdir(), and pathempty() calls in pathrm() and pathmk() do not return() on failure.
If its set to true they just silently go about their business regardless. This isn't a good idea but its there if you want it.
=head3 $DirPerms
Mode to pass to any mkdir() calls. Defaults to 0777 as per umask()'s POD. Explicitly having this allows older perls to be able to use FCR and might add a bit of
flexibility for you.
Any value you set it to should be suitable for oct()
=head3 Path functions
These functions exist soley because they were necessary for the move and copy functions to have the features they do and not because they are of themselves the
purpose of this module. That being said, here is how they work so you can understand how the copy and move funtions work and use them by themselves if you wish.
=head4 pathrm()
Removes a given path recursively. It removes the *entire* path so be carefull!!!
Returns 2 if the given path is not a directory.
File::Copy::Recursive::pathrm('foo/bar/baz') or die $!;
# foo no longer exists
Same as:
rmdir 'foo/bar/baz' or die $!;
rmdir 'foo/bar' or die $!;
rmdir 'foo' or die $!;
An optional second argument makes it call pathempty() before any rmdir()'s when set to true.
File::Copy::Recursive::pathrm('foo/bar/baz', 1) or die $!;
# foo no longer exists
Same as:PFSCheck
File::Copy::Recursive::pathempty('foo/bar/baz') or die $!;
rmdir 'foo/bar/baz' or die $!;
File::Copy::Recursive::pathempty('foo/bar/') or die $!;
rmdir 'foo/bar' or die $!;
File::Copy::Recursive::pathempty('foo/') or die $!;
rmdir 'foo' or die $!;
An optional third argument acts like $File::Copy::Recursive::NoFtlPth, again probably not a good idea.
=head4 pathempty()
Recursively removes the given directory's contents so it is empty. returns 2 if argument is not a directory, 1 on successfully emptying the directory.
File::Copy::Recursive::pathempty($pth) or die $!;
# $pth is now an empty directory
=head4 pathmk()
Creates a given path recursively. Creates foo/bar/baz even if foo does not exist.
File::Copy::Recursive::pathmk('foo/bar/baz') or die $!;
An optional second argument if true acts just like $File::Copy::Recursive::NoFtlPth, which means you'd never get your die() if something went wrong. Again,
probably a *bad* idea.
=head4 pathrmdir()
Same as rmdir() but it calls pathempty() first to recursively empty it first since rmdir can not remove a directory with contents.
Just removes the top directory the path given instead of the entire path like pathrm(). Return 2 if given argument does not exist (IE its already gone). Return
false if it exists but is not a directory.
=head2 Preserving Mode
By default a quiet attempt is made to change the new file or directory to the mode of the old one.
To turn this behavior off set
$File::Copy::Recursive::KeepMode
to false;
=head2 Managing Depth
You can set the maximum depth a directory structure is recursed by setting:
$File::Copy::Recursive::MaxDepth
to a whole number greater than 0.
=head2 SymLinks
If your system supports symlinks then symlinks will be copied as symlinks instead of as the target file.
Perl's symlink() is used instead of File::Copy's copy()
You can customize this behavior by setting $File::Copy::Recursive::CopyLink to a true or false value.
It is already set to true or false dending on your system's support of symlinks so you can check it with an if statement to see how it will behave:
if($File::Copy::Recursive::CopyLink) {
print "Symlinks will be preserved\n";
} else {
print "Symlinks will not be preserved because your system does not support it\n";
}
If symlinks are being copied you can set $File::Copy::Recursive::BdTrgWrn to true to make it carp when it copies a link whose target does not exist. Its false
by default.
local $File::Copy::Recursive::BdTrgWrn = 1;
=head2 Removing existing target file or directory before copying.
This can be done by setting $File::Copy::Recursive::RMTrgFil or $File::Copy::Recursive::RMTrgDir for file or directory behavior respectively.
0 = off (This is the default)
1 = carp() $! if removal fails
2 = return if removal fails
local $File::Copy::Recursive::RMTrgFil = 1;
fcopy($orig, $target) or die $!;
# if it fails it does warn() and keeps going
local $File::Copy::Recursive::RMTrgDir = 2;
dircopy($orig, $target) or die $!;
# if it fails it does your "or die"
This should be unnecessary most of the time but its there if you need it :)
=head2 Turning off stat() check
By default the files or directories are checked to see if they are the same (IE linked, or two paths (absolute/relative or different relative paths) to the same
file) by comparing the file's stat() info.
It's a very efficient check that croaks if they are and shouldn't be turned off but if you must for some weird reason just set $File::Copy::Recursive::PFSCheck
to a false value. ("PFS" stands for "Physical File System")
=head2 Emulating cp -rf dir1/ dir2/
By default dircopy($dir1,$dir2) will put $dir1's contents right into $dir2 whether $dir2 exists or not.
You can make dircopy() emulate cp -rf by setting $File::Copy::Recursive::CPRFComp to true.
NOTE: This only emulates -f in the sense that it does not prompt. It does not remove the target file or directory if it exists.
If you need to do that then use the variables $RMTrgFil and $RMTrgDir described in "Removing existing target file or directory before copying" above.
That means that if $dir2 exists it puts the contents into $dir2/$dir1 instead of $dir2 just like cp -rf.
If $dir2 does not exist then the contents go into $dir2 like normal (also like cp -rf)
So assuming 'foo/file':
dircopy('foo', 'bar') or die $!;
# if bar does not exist the result is bar/file
# if bar does exist the result is bar/file
$File::Copy::Recursive::CPRFComp = 1;
dircopy('foo', 'bar') or die $!;
# if bar does not exist the result is bar/file
# if bar does exist the result is bar/foo/file
You can also specify a star for cp -rf glob type behavior:
dircopy('foo/*', 'bar') or die $!;
# if bar does not exist the result is bar/file
# if bar does exist the result is bar/file
$File::Copy::Recursive::CPRFComp = 1;
dircopy('foo/*', 'bar') or die $!;
# if bar does not exist the result is bar/file
# if bar does exist the result is bar/file
NOTE: The '*' is only like cp -rf foo/* and *DOES NOT EXPAND PARTIAL DIRECTORY NAMES LIKE YOUR SHELL DOES* (IE not like cp -rf fo* to copy foo/*)
=head2 Allowing Copy Loops
If you want to allow:
cp -rf . foo/
type behavior set $File::Copy::Recursive::CopyLoop to true.
This is false by default so that a check is done to see if the source directory will contain the target directory and croaks to avoid this problem.
If you ever find a situation where $CopyLoop = 1 is desirable let me know (IE its a bad bad idea but is there if you want it)
(Note: On Windows this was necessary since it uses stat() to detemine samedness and stat() is essencially useless for this on Windows.
The test is now simply skipped on Windows but I'd rather have an actual reliable check if anyone in Microsoft land would care to share)
=head1 SEE ALSO
L<File::Copy> L<File::Spec>
=head1 TO DO
I am currently working on and reviewing some other modules to use in the new interface so we can lose the horrid globals as well as some other undesirable
traits and also more easily make available some long standing requests.
Tests will be easier to do with the new interface and hence the testing focus will shift to the new interface and aim to be comprehensive.
The old interface will work, it just won't be brought in until it is used, so it will add no overhead for users of the new interface.
I'll add this after the latest verision has been out for a while with no new features or issues found :)
=head1 AUTHOR
Daniel Muey, L<http://drmuey.com/cpan_contact.pl>
=head1 COPYRIGHT AND LICENSE
Copyright 2004 by Daniel Muey
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
+109 -81
View File
@@ -4,11 +4,12 @@
package Lib::Auto; package Lib::Auto;
use strict; use strict;
use warnings; use warnings;
use feature qw(say);
use English qw(-no_match_vars); use English qw(-no_match_vars);
use Sys::Hostname; use Sys::Hostname;
use feature qw(switch); use feature qw(switch);
use API::Std qw(hook_add conf_get err); use API::Std qw(hook_add conf_get err);
use API::Log qw(println dbug alog); use API::Log qw(dbug alog);
our $VERSION = 3.000000; our $VERSION = 3.000000;
# Core events. # Core events.
@@ -19,7 +20,7 @@ API::Std::event_add('on_rehash');
sub checkver sub checkver
{ {
if (!$Auto::NUC and Auto::RSTAGE ne 'd') { if (!$Auto::NUC and Auto::RSTAGE ne 'd') {
println '* Connecting to update server...'; say '* Connecting to update server...';
my $uss = IO::Socket::INET->new( my $uss = IO::Socket::INET->new(
'Proto' => 'tcp', 'Proto' => 'tcp',
'PeerAddr' => 'dist.xelhua.org', 'PeerAddr' => 'dist.xelhua.org',
@@ -37,11 +38,11 @@ sub checkver
} }
elsif ($v eq 'version') { elsif ($v eq 'version') {
if (Auto::VER.q{.}.Auto::SVER.q{.}.Auto::REV.Auto::RSTAGE ne $c) { if (Auto::VER.q{.}.Auto::SVER.q{.}.Auto::REV.Auto::RSTAGE ne $c) {
println('!!! NOTICE !!! Your copy of Auto is outdated. Current version: '.Auto::VER.q{.}.Auto::SVER.q{.}.Auto::REV.Auto::RSTAGE.' - Latest version: '.$c); say('!!! NOTICE !!! Your copy of Auto is outdated. Current version: '.Auto::VER.q{.}.Auto::SVER.q{.}.Auto::REV.Auto::RSTAGE.' - Latest version: '.$c);
println('!!! NOTICE !!! You can get the latest Auto by downloading '.$dll); say('!!! NOTICE !!! You can get the latest Auto by downloading '.$dll);
} }
else { else {
println('* Auto is up-to-date.'); say('* Auto is up-to-date.');
} }
} }
} }
@@ -54,7 +55,7 @@ sub rehash
my %newsettings = $Auto::CONF->parse or err(2, 'Failed to parse configuration file!', 0) and return; my %newsettings = $Auto::CONF->parse or err(2, 'Failed to parse configuration file!', 0) and return;
# Check for required configuration values. # Check for required configuration values.
my @REQCVALS = qw(locale expire_logs server fantasy_pf ratelimit database:format bantype); my @REQCVALS = qw(locale expire_logs server fantasy_pf ratelimit bantype);
foreach my $REQCVAL (@REQCVALS) { foreach my $REQCVAL (@REQCVALS) {
if (!defined $newsettings{$REQCVAL}) { if (!defined $newsettings{$REQCVAL}) {
err(2, "Missing required configuration value: $REQCVAL", 0) and return; err(2, "Missing required configuration value: $REQCVAL", 0) and return;
@@ -122,7 +123,7 @@ sub rehash
if (conf_get('module')) { if (conf_get('module')) {
alog '* Loading modules...'; alog '* Loading modules...';
foreach (@{ (conf_get('module'))[0] }) { foreach (@{ (conf_get('module'))[0] }) {
if (!API::Std::mod_exists($_)) { Auto::mod_load($_); } if (!API::Std::mod_exists($_)) { Auto::mod_load($_) }
} }
} }
@@ -133,75 +134,15 @@ sub rehash
# Iterate through each configured server. # Iterate through each configured server.
foreach my $cskey (keys %cservers) { foreach my $cskey (keys %cservers) {
if (!defined $Auto::SOCKET{$cskey}) { if (!defined $Auto::SOCKET{$cskey}) {
# Prepare socket data. ircsock(\%{$cservers{$cskey}}, $cskey);
my %conndata = (
Proto => 'tcp',
LocalAddr => $cservers{$cskey}{'bind'}[0],
PeerAddr => $cservers{$cskey}{'host'}[0],
PeerPort => $cservers{$cskey}{'port'}[0],
Timeout => 20,
);
# Set IPv6/SSL data.
my $use6 = 0;
my $usessl = 0;
if (defined $cservers{$cskey}{'ipv6'}[0]) { $use6 = $cservers{$cskey}{'ipv6'}[0]; }
if (defined $cservers{$cskey}{'ssl'}[0]) { $usessl = $cservers{$cskey}{'ssl'}[0]; }
# CertFP.
if ($usessl) {
if (defined $cservers{$cskey}{'certfp'}[0]) {
if ($cservers{$cskey}{'certfp'}[0] eq 1) {
$conndata{'SSL_use_cert'} = 1;
if (defined $cservers{$cskey}{'certfp_cert'}[0]) {
$conndata{'SSL_cert_file'} = "$Auto::Bin/../etc/certs/".$cservers{$cskey}{'certfp_cert'}[0];
}
if (defined $cservers{$cskey}{'certfp_key'}[0]) {
$conndata{'SSL_key_file'} = "$Auto::Bin/../etc/certs/".$cservers{$cskey}{'certfp_key'}[0];
}
if (defined $cservers{$cskey}{'certfp_pass'}[0]) {
$conndata{'SSL_passwd_cb'} = sub { return $cservers{$cskey}{'certfp_pass'}[0]; };
}
}
} }
} }
# Create the socket. # Check for server connections.
if ($use6) { if (!keys %Auto::SOCKET) {
$Auto::SOCKET{$cskey} = IO::Socket::INET6->new(%conndata) or # Or error. err(2, 'No IRC connections -- Exiting program.', 0);
err(2, 'Failed to connect to server ('.$ERRNO.'): '.$cskey.' ['.$cservers{$cskey}{'host'}[0].q{:}.$cservers{$cskey}{'port'}[0].']', 0) API::Std::event_run('on_shutdown');
and delete $Auto::SOCKET{$cskey} and next; exit 1;
}
else {
if ($usessl) {
$Auto::SOCKET{$cskey} = IO::Socket::SSL->new(%conndata) or # Or error.
err(2, 'Failed to connect to server ('.$ERRNO.'): '.$cskey.' ['.$cservers{$cskey}{'host'}[0].q{:}.$cservers{$cskey}{'port'}[0].']', 0)
and delete $Auto::SOCKET{$cskey} and next;
}
else {
$Auto::SOCKET{$cskey} = IO::Socket::INET->new(%conndata) or # Or error.
err(2, 'Failed to connect to server ('.$ERRNO.'): '.$cskey.' ['.$cservers{$cskey}{'host'}[0].q{:}.$cservers{$cskey}{'port'}[0].']', 0)
and delete $Auto::SOCKET{$cskey} and next;
}
}
# Send PASS if we have one.
if (defined $cservers{$cskey}{'pass'}[0]) {
Auto::socksnd($cskey, 'PASS :'.$cservers{$cskey}{'pass'}[0]) or
err(2, 'Failed to connect to server: '.$cskey.' ['.$cservers{$cskey}{'host'}[0].q{:}.$cservers{$cskey}{'port'}[0].']', 0)
and next;
}
API::Std::event_run('on_preconnect', $cskey);
# Send NICK/USER.
API::IRC::nick($cskey, $cservers{$cskey}{'nick'}[0]);
Auto::socksnd($cskey, 'USER '.$cservers{$cskey}{'ident'}[0].q{ }.hostname.q{ }.$cservers{$cskey}{'host'}[0].' :'.$cservers{$cskey}{'realname'}[0]) or
err(2, 'Failed to connect to server: '.$cskey.' ['.$cservers{$cskey}{'host'}[0].q{:}.$cservers{$cskey}{'port'}[0].']', 0)
and next;
# Add to select.
$Auto::SELECT->add($Auto::SOCKET{$cskey});
# Success!
alog '** Successfully connected to server: '.$cskey;
dbug '** Successfully connected to server: '.$cskey;
}
} }
# Now trigger on_rehash. # Now trigger on_rehash.
@@ -210,10 +151,97 @@ sub rehash
return 1; return 1;
} }
# Socket creation.
sub ircsock {
my ($cdata, $svrname) = @_;
# Prepare socket data.
my %conndata = (
Proto => 'tcp',
LocalAddr => $cdata->{'bind'}[0],
PeerAddr => $cdata->{'host'}[0],
PeerPort => $cdata->{'port'}[0],
Timeout => 20,
);
# Set IPv6/SSL data.
my $use6 = 0;
my $usessl = 0;
if (defined $cdata->{'ipv6'}[0]) { $use6 = $cdata->{'ipv6'}[0] }
if (defined $cdata->{'ssl'}[0]) { $usessl = $cdata->{'ssl'}[0] }
# Check for appropriate build data.
if ($usessl) {
if ($Auto::ENFEAT !~ m/ssl/ixsm) { err(2, '** Auto not built with SSL support: Aborting connection to '.$svrname, 0); return }
}
if ($use6) {
if ($Auto::ENFEAT !~ m/ipv6/ixsm) { err(2, '** Auto not built with IPv6 support: Aborting connection to '.$svrname, 0); return }
}
# CertFP.
if ($usessl) {
if (defined $cdata->{'certfp'}[0]) {
if ($cdata->{'certfp'}[0] eq 1) {
$conndata{'SSL_use_cert'} = 1;
if (defined $cdata->{'certfp_cert'}[0]) {
$conndata{'SSL_cert_file'} = "$Auto::bin{etc}/certs/".$cdata->{'certfp_cert'}[0];
}
if (defined $cdata->{'certfp_key'}[0]) {
$conndata{'SSL_key_file'} = "$Auto::bin{etc}/certs/".$cdata->{'certfp_key'}[0];
}
if (defined $cdata->{'certfp_pass'}[0]) {
$conndata{'SSL_passwd_cb'} = sub { return $cdata->{'certfp_pass'}[0] };
}
}
}
}
# Create the socket.
if ($use6) {
$Auto::SOCKET{$svrname} = IO::Socket::INET6->new(%conndata) or # Or error.
err(2, 'Failed to connect to server ('.$ERRNO.'): '.$svrname.' ['.$cdata->{'host'}[0].q{:}.$cdata->{'port'}[0].']', 0)
and delete $Auto::SOCKET{$svrname} and return;
}
else {
if ($usessl) {
$Auto::SOCKET{$svrname} = IO::Socket::SSL->new(%conndata) or # Or error.
err(2, 'Failed to connect to server ('.$ERRNO.'): '.$svrname.' ['.$cdata->{'host'}[0].q{:}.$cdata->{'port'}[0].']', 0)
and delete $Auto::SOCKET{$svrname} and next;
}
else {
$Auto::SOCKET{$svrname} = IO::Socket::INET->new(%conndata) or # Or error.
err(2, 'Failed to connect to server ('.$ERRNO.'): '.$svrname.' ['.$cdata->{'host'}[0].q{:}.$cdata->{'port'}[0].']', 0)
and delete $Auto::SOCKET{$svrname} and next;
binmode($Auto::SOCKET{$svrname}, ':encoding(UTF-8)');
}
}
# Create a CAP entry if it doesn't already exist.
if (!$Proto::IRC::cap{$svrname}) { $Proto::IRC::cap{$svrname} = 'multi-prefix' }
# Send PASS if we have one.
if (defined $cdata->{'pass'}[0]) {
Auto::socksnd($svrname, 'PASS :'.$cdata->{'pass'}[0]) or return;
}
# Send CAP LS.
Auto::socksnd($svrname, 'CAP LS');
# Trigger on_preconnect.
API::Std::event_run('on_preconnect', $svrname);
# Send NICK/USER.
API::IRC::nick($svrname, $cdata->{'nick'}[0]);
Auto::socksnd($svrname, 'USER '.$cdata->{'ident'}[0].q{ }.hostname.q{ }.$cdata->{'host'}[0].' :'.$cdata->{'realname'}[0]) or return;
# Add to select.
$Auto::SELECT->add($Auto::SOCKET{$svrname});
# Success!
alog '** Successfully connected to server: '.$svrname;
dbug '** Successfully connected to server: '.$svrname;
return 1;
}
# Shutdown. # Shutdown.
hook_add('on_shutdown', 'shutdown.core_cleanup', sub { hook_add('on_shutdown', 'shutdown.core_cleanup', sub {
if (defined $Auto::DB) { $Auto::DB->disconnect; } if (defined $Auto::DB) { $Auto::DB->disconnect }
if (-e "$Auto::Bin/auto.pid") { unlink "$Auto::Bin/auto.pid"; } if ($Auto::UPREFIX) { if (-e "$Auto::bin{cwd}/auto.pid") { unlink "$Auto::bin{cwd}/auto.pid" } }
else { if (-e "$Auto::Bin/auto.pid") { unlink "$Auto::Bin/auto.pid" } }
return 1; return 1;
}); });
@@ -226,7 +254,7 @@ sub signal_term
{ {
API::Std::event_run('on_sigterm'); API::Std::event_run('on_sigterm');
API::Std::event_run('on_shutdown'); API::Std::event_run('on_shutdown');
foreach (keys %Auto::SOCKET) { API::IRC::quit($_, 'Caught SIGTERM'); } foreach (keys %Auto::SOCKET) { API::IRC::quit($_, 'Caught SIGTERM') }
dbug '!!! Caught SIGTERM; terminating...'; dbug '!!! Caught SIGTERM; terminating...';
alog '!!! Caught SIGTERM; terminating...'; alog '!!! Caught SIGTERM; terminating...';
sleep 1; sleep 1;
@@ -238,7 +266,7 @@ sub signal_int
{ {
API::Std::event_run('on_sigint'); API::Std::event_run('on_sigint');
API::Std::event_run('on_shutdown'); API::Std::event_run('on_shutdown');
foreach (keys %Auto::SOCKET) { API::IRC::quit($_, 'Caught SIGINT'); } foreach (keys %Auto::SOCKET) { API::IRC::quit($_, 'Caught SIGINT') }
dbug '!!! Caught SIGINT; terminating...'; dbug '!!! Caught SIGINT; terminating...';
alog '!!! Caught SIGINT; terminating...'; alog '!!! Caught SIGINT; terminating...';
sleep 1; sleep 1;
@@ -261,7 +289,7 @@ sub signal_perlwarn
my ($warnmsg) = @_; my ($warnmsg) = @_;
$warnmsg =~ s/(\n|\r)//xsmg; $warnmsg =~ s/(\n|\r)//xsmg;
alog 'Perl Warning: '.$warnmsg; alog 'Perl Warning: '.$warnmsg;
if ($Auto::DEBUG) { println 'Perl Warning: '.$warnmsg; } if ($Auto::DEBUG) { say 'Perl Warning: '.$warnmsg }
return 1; return 1;
} }
@@ -273,13 +301,13 @@ sub signal_perldie
return if $EXCEPTIONS_BEING_CAUGHT; return if $EXCEPTIONS_BEING_CAUGHT;
alog 'Perl Fatal: '.$diemsg.' -- Terminating program!'; alog 'Perl Fatal: '.$diemsg.' -- Terminating program!';
foreach (keys %Auto::SOCKET) { API::IRC::quit($_, 'A fatal error occurred!'); } foreach (keys %Auto::SOCKET) { API::IRC::quit($_, 'A fatal error occurred!') }
API::Std::event_run('on_shutdown'); API::Std::event_run('on_shutdown');
sleep 1; sleep 1;
println 'FATAL: '.$diemsg; say 'FATAL: '.$diemsg;
exit; exit;
} }
1; 1;
# vim: set ai sw=4 ts=4: # vim: set ai et sw=4 ts=4:
+15 -11
View File
@@ -6,8 +6,6 @@ use strict;
use warnings; use warnings;
use Exporter; use Exporter;
use English qw(-no_match_vars); use English qw(-no_match_vars);
use FindBin qw($Bin);
our $Bin = $Bin;
our $VERSION = 1.00; our $VERSION = 1.00;
our @ISA = qw(Exporter); our @ISA = qw(Exporter);
@@ -39,28 +37,33 @@ sub modfind
sub build sub build
{ {
my ($features) = @_; my ($features, $Bin, $syswide) = @_;
if (!defined $syswide) { $syswide = 0 }
open(my $FTIME, q{>}, "$Bin/build/time") or println "Failed to install." and exit; open(my $FTIME, q{>}, "$Bin/time") or println "Failed to install." and exit;
print $FTIME time."\n" or println "Failed to install." and exit; print $FTIME time."\n" or println "Failed to install." and exit;
close $FTIME or println "Failed to install." and exit; close $FTIME or println "Failed to install." and exit;
open(my $FOS, q{>}, "$Bin/build/os") or println "Failed to install." and exit; open(my $FOS, q{>}, "$Bin/os") or println "Failed to install." and exit;
print $FOS $OSNAME."\n" or println "Failed to install." and exit; print $FOS $OSNAME."\n" or println "Failed to install." and exit;
close $FOS or println "Failed to install." and exit; close $FOS or println "Failed to install." and exit;
open(my $FFEAT, q{>}, "$Bin/build/feat") or println "Failed to install." and exit; open(my $FFEAT, q{>}, "$Bin/feat") or println "Failed to install." and exit;
print $FFEAT $features."\n" or println "Failed to install." and exit; print $FFEAT $features."\n" or println "Failed to install." and exit;
close $FFEAT or println "Failed to install." and exit; close $FFEAT or println "Failed to install." and exit;
open(my $FPERL, q{>}, "$Bin/build/perl") or println "Failed to install." and exit; open(my $FPERL, q{>}, "$Bin/perl") or println "Failed to install." and exit;
print $FPERL "$]\n" or println "Failed to install." and exit; print $FPERL "$]\n" or println "Failed to install." and exit;
close $FPERL or println "Failed to install." and exit; close $FPERL or println "Failed to install." and exit;
open(my $FVER, q{>}, "$Bin/build/ver") or println "Failed to install." and exit; open(my $FVER, q{>}, "$Bin/ver") or println "Failed to install." and exit;
print $FVER "3.0.0d\n" or println "Failed to install." and exit; print $FVER "3.0.0d\n" or println "Failed to install." and exit;
close $FVER or println "Failed to install." and exit; close $FVER or println "Failed to install." and exit;
open my $FSYS, '>', "$Bin/syswide" or println "Failed to install." and exit;
print {$FSYS} "$syswide\n" or println "Failed to install." and exit;
close $FSYS or println "Failed to install." and exit;
return 1; return 1;
} }
@@ -114,21 +117,22 @@ sub checkcore
sub installmods sub installmods
{ {
my ($prefix) = @_;
print 'Would you like to install any official modules? [y/n] '; print 'Would you like to install any official modules? [y/n] ';
my $response = <STDIN>; my $response = <STDIN>;
chomp $response; chomp $response;
if (lc $response eq 'y') { if (lc $response eq 'y') {
println 'What modules would you like to install? (separate by commas)'; println 'What modules would you like to install? (separate by commas)';
println 'Available modules: Badwords, Bitly, Calc, EightBall, FML, Greet, HelloChan, IsItUp, QDB, SASLAuth, Weather'; println 'Available modules: AUR, Badwords, Bitly, BotStats, Calc, ChanTopics, Dictionary, EightBall, Eval, FML, Greet, HelloChan, IsItUp, LinkTitle, LOLCAT, Oper, QDB, SASLAuth, UNO, Weather, Werewolf';
print '> '; print '> ';
my $modules = <STDIN>; chomp $modules; my $modules = <STDIN>; chomp $modules;
$modules =~ s/ //g; $modules =~ s/ //g;
my @modst = split ',', $modules; my @modst = split ',', $modules;
foreach (@modst) { foreach (@modst) {
system "$Bin/bin/buildmod $_"; system "perl \"$prefix/bin/buildmod\" $_";
} }
} }
} }
1; 1;
# vim: set ai sw=4 ts=4: # vim: set ai et sw=4 ts=4:
+10 -10
View File
@@ -13,17 +13,17 @@ sub new
my $self = bless {}, $class; my $self = bless {}, $class;
# Check to see if the configuration file exists. # Check to see if the configuration file exists.
if (!-e "$Auto::Bin/../etc/$file") { if (!-e "$Auto::bin{etc}/$file") {
return 0; return;
} }
# Open, read and close the config. # Open, read and close the config.
open(my $FCONF, q{<}, "$Auto::Bin/../etc/$file") or return 0; open(my $FCONF, q{<}, "$Auto::bin{etc}/$file") or return;
my @cosfl = <$FCONF> or return 0; my @cosfl = <$FCONF> or return;
close $FCONF or return 0; close $FCONF or return;
# Save it to self variable. # Save it to self variable.
$self->{'config'}->{'path'} = "$Auto::Bin/../etc/$file"; $self->{'config'}->{'path'} = "$Auto::bin{etc}/$file";
return $self; return $self;
} }
@@ -38,9 +38,9 @@ sub parse
my (%rs); my (%rs);
# Open, read and close it. # Open, read and close it.
open(my $FCONF, q{<}, "$file") or return 0; open(my $FCONF, q{<}, "$file") or return;
my @fbuf = <$FCONF> or return 0; my @fbuf = <$FCONF> or return;
close $FCONF or return 0; close $FCONF or return;
# Iterate the file. # Iterate the file.
foreach my $buff (@fbuf) { foreach my $buff (@fbuf) {
@@ -177,4 +177,4 @@ sub parse
1; 1;
# vim: set ai sw=4 ts=4: # vim: set ai et sw=4 ts=4:
-679
View File
@@ -1,679 +0,0 @@
# lib/Parser/IRC.pm - Subroutines for parsing incoming data from IRC.
# Copyright (C) 2010-2011 Xelhua Development Group, et al.
# This program is free software; rights to this code are stated in doc/LICENSE.
package Parser::IRC;
use strict;
use warnings;
use API::Std qw(conf_get err awarn trans);
use API::IRC;
# Raw parsing hash.
our %RAWC = (
'001' => \&num001,
'005' => \&num005,
'353' => \&num353,
'432' => \&num432,
'433' => \&num433,
'438' => \&num438,
'465' => \&num465,
'471' => \&num471,
'473' => \&num473,
'474' => \&num474,
'475' => \&num475,
'477' => \&num477,
'JOIN' => \&cjoin,
'KICK' => \&kick,
'MODE' => \&mode,
'NICK' => \&nick,
'NOTICE' => \&notice,
'PART' => \&part,
'PRIVMSG' => \&privmsg,
'QUIT' => \&quit,
'TOPIC' => \&topic,
);
# Variables for various functions.
our (%got_001, %botnick, %botchans, %csprefix, %chanusers, %chanmodes);
# Events.
API::Std::event_add("on_connect");
API::Std::event_add("on_rcjoin");
API::Std::event_add("on_ucjoin");
API::Std::event_add("on_kick");
API::Std::event_add("on_nick");
API::Std::event_add("on_notice");
API::Std::event_add("on_cprivmsg");
API::Std::event_add("on_uprivmsg");
API::Std::event_add("on_quit");
API::Std::event_add("on_topic");
# Parse raw data.
sub ircparse
{
my ($svr, $data) = @_;
# Split spaces into @ex.
my @ex = split /\s+/, $data;
# Make sure there is enough data.
if (defined $ex[0] and defined $ex[1]) {
# If it's a ping...
if ($ex[0] eq 'PING') {
# send a PONG.
Auto::socksnd($svr, "PONG ".$ex[1]);
}
# If it's AUTHENTICATE
elsif ($ex[0] eq 'AUTHENTICATE') {
if (API::Std::mod_exists("SASLAuth")) {
M::SASLAuth::handle_authenticate($svr, @ex);
}
}
else {
# otherwise, check %RAWC for ex[1].
if (defined $RAWC{$ex[1]}) {
&{ $RAWC{$ex[1]} }($svr, @ex);
}
}
}
return 1;
}
###########################
# Raw parsing subroutines #
###########################
# Parse: Numeric:001
# Successful connection.
sub num001
{
my ($svr, @ex) = @_;
$got_001{$svr} = 1;
# In case we don't get NICK from the server.
if (defined $botnick{$svr}{newnick}) {
$botnick{$svr}{nick} = $botnick{$svr}{newnick};
delete $botnick{$svr}{newnick};
}
# Trigger on_connect.
API::Std::event_run("on_connect", $svr);
return 1;
}
# Parse: Numeric:005
# Prefixes and channel modes.
sub num005
{
my ($svr, @ex) = @_;
# Find PREFIX and CHANMODES.
foreach my $ex (@ex) {
if ($ex =~ m/^PREFIX/xsm) {
# Found PREFIX.
my $rpx = substr($ex, 8);
my ($pm, $pp) = split('\)', $rpx);
my @apm = split(//, $pm);
my @app = split(//, $pp);
foreach my $ppm (@apm) {
# Store data.
$csprefix{$svr}{$ppm} = shift(@app);
}
}
elsif ($ex =~ m/^CHANMODES/xsm) {
# Found CHANMODES.
my ($mtl, $mtp, $mtpp, $mts) = split m/[,]/xsm, substr($ex, 10);
# List modes.
foreach (split(//, $mtl)) { $chanmodes{$svr}{$_} = 1; }
# Modes with parameter.
foreach (split(//, $mtp)) { $chanmodes{$svr}{$_} = 2; }
# Modes with parameter when +.
foreach (split(//, $mtpp)) { $chanmodes{$svr}{$_} = 3; }
# Modes without parameter.
foreach (split(//, $mts)) { $chanmodes{$svr}{$_} = 4; }
}
}
return 1;
}
# Parse: Numeric:353
# NAMES reply.
sub num353
{
my ($svr, @ex) = @_;
# Get rid of the colon.
$ex[5] = substr($ex[5], 1);
# Delete the old chanusers hash if it exists.
delete $chanusers{$svr}{$ex[4]} if (defined $chanusers{$svr}{$ex[4]});
# Iterate through each user.
for (my $i = 5; $i < scalar(@ex); $i++) {
my $fi = 0;
foreach (keys %{ $csprefix{$svr} }) {
# Check if the user has status in the channel.
if (substr($ex[$i], 0, 1) eq $csprefix{$svr}{$_}) {
# He/she does. Lets set that.
if (defined $chanusers{$svr}{$ex[4]}{lc(substr($ex[$i], 1))}) {
# If the user has multiple statuses.
$chanusers{$svr}{$ex[4]}{lc(substr($ex[$i], 1))} .= $_;
}
else {
# Or not.
$chanusers{$svr}{$ex[4]}{lc(substr($ex[$i], 1))} = $_;
}
$fi = 1;
}
}
# They had status, so go to the next user.
next if $fi;
# They didn't, set them as a normal user.
if (!defined $chanusers{$svr}{$ex[4]}{lc($ex[$i])}) {
$chanusers{$svr}{$ex[4]}{lc($ex[$i])} = 1;
}
}
return 1;
}
# Parse: Numeric:432
# Erroneous nickname.
sub num432
{
my ($svr, undef) = @_;
if ($got_001{$svr}) {
err(3, "Got error from server[".$svr."]: Erroneous nickname.", 0);
}
else {
err(2, "Got error from server[".$svr."] before 001: Erroneous nickname. Closing connection.", 0);
API::IRC::quit($svr, "An error occurred.");
}
delete $botnick{$svr}{newnick} if (defined $botnick{$svr}{newnick});
return 1;
}
# Parse: Numeric:433
# Nickname is already in use.
sub num433
{
my ($svr, undef) = @_;
if (defined $botnick{$svr}{newnick}) {
API::IRC::nick($svr, $botnick{$svr}{newnick}."_");
delete $botnick{$svr}{newnick} if (defined $botnick{$svr}{newnick});
}
return 1;
}
# Parse: Numeric:438
# Nick change too fast.
sub num438
{
my ($svr, @ex) = @_;
if (defined $botnick{$svr}{newnick}) {
API::Std::timer_add("num438_".$botnick{$svr}{newnick}, 1, $ex[11], sub {
API::IRC::nick($Parser::IRC::botnick{$svr}{newnick});
delete $botnick{$svr}{newnick} if (defined $botnick{$svr}{newnick});
});
}
return 1;
}
# Parse: Numeric:465
# You're banned creep!
sub num465
{
my ($svr, undef) = @_;
err(3, "Banned from ".$svr."! Closing link...", 0);
return 1;
}
# Parse: Numeric:471
# Cannot join channel: Channel is full.
sub num471
{
my ($svr, (undef, undef, undef, $chan)) = @_;
err(3, "Cannot join channel ".$chan." on ".$svr.": Channel is full.", 0);
return 1;
}
# Parse: Numeric:473
# Cannot join channel: Channel is invite-only.
sub num473
{
my ($svr, (undef, undef, undef, $chan)) = @_;
err(3, "Cannot join channel ".$chan." on ".$svr.": Channel is invite-only.", 0);
return 1;
}
# Parse: Numeric:474
# Cannot join channel: Banned from channel.
sub num474
{
my ($svr, (undef, undef, undef, $chan)) = @_;
err(3, "Cannot join channel ".$chan." on ".$svr.": Banned from channel.", 0);
return 1;
}
# Parse: Numeric:475
# Cannot join channel: Bad key.
sub num475
{
my ($svr, (undef, undef, undef, $chan)) = @_;
err(3, "Cannot join channel ".$chan." on ".$svr.": Bad key.", 0);
return 1;
}
# Parse: Numeric:477
# Cannot join channel: Need registered nickname.
sub num477
{
my ($svr, (undef, undef, undef, $chan)) = @_;
err(3, "Cannot join channel ".$chan." on ".$svr.": Need registered nickname.", 0);
return 1;
}
# Parse: JOIN
sub cjoin
{
my ($svr, @ex) = @_;
my %src = API::IRC::usrc(substr($ex[0], 1));
my $chan = $ex[2];
$chan =~ s/^://gxsm;
# Check if this is coming from ourselves.
if ($src{nick} eq $botnick{$svr}{nick}) {
$botchans{$svr}{lc(substr $ex[2], 1)} = 1;
API::Std::event_run("on_ucjoin", ($svr, $chan));
}
else {
# It isn't. Update chanusers and trigger on_rcjoin.
$chanusers{$svr}{lc(substr $ex[2], 1)}{$src{nick}} = 1;
$src{svr} = $svr;
API::Std::event_run("on_rcjoin", (\%src, $chan));
}
return 1;
}
# Parse: KICK
sub kick
{
my ($svr, @ex) = @_;
my %src = API::IRC::usrc(substr($ex[0], 1));
# Update chanusers.
delete $chanusers{$svr}{$ex[2]}{$ex[3]} if defined $chanusers{$svr}{$ex[2]}{$ex[3]};
# Set $msg to the kick message.
my $msg = 0;
if (defined $ex[4]) {
$msg = substr($ex[4], 1);
if (defined $ex[5]) {
for (my $i = 5; $i < scalar(@ex); $i++) {
$msg .= " ".$ex[$i];
}
}
}
# Check if we were the ones kicked.
if (lc($ex[3]) eq lc($botnick{$svr}{nick})) {
# We were kicked!
# Delete channel from botchans.
delete $botchans{$svr}{$ex[2]};
# Log this horrible act.
API::Log::alog("I was kicked from ".$svr."/".$ex[2]." by ".$src{nick}."! Reason: ".$msg);
# Rejoin if we're told to in config.
if (conf_get("server:$svr:autorejoin")) {
if ((conf_get("server:$svr:autorejoin"))[0][0] eq 1) {
API::IRC::cjoin($svr, $ex[2]);
}
}
}
else {
# We weren't. Update chanusers and trigger on_kick.
if (defined $chanusers{$svr}{$ex[2]}{$ex[3]}) { delete $chanusers{$svr}{$ex[2]}{$ex[3]}; }
API::Std::event_run("on_kick", ($svr, \%src, $ex[2], $ex[3], $msg));
}
return 1;
}
# Parse: MODE
sub mode
{
my ($svr, @ex) = @_;
if ($ex[2] ne $botnick{$svr}{nick}) {
# Set data we'll need later.
my $chan = $ex[2];
my $modes = $ex[3];
# Get rid of the useless data, so the mode parser will work smoothly.
shift @ex; shift @ex; shift @ex; shift @ex;
# Check if the modes contain any status modes.
my $nt = 0;
foreach (keys %{ $csprefix{$svr} }) {
if ($modes =~ /($_)/) {
$nt = 1;
last;
}
}
if ($nt) {
# It did. Lets parse the changes.
my @ma = split(//, $modes);
my $op = 1;
foreach my $maf (@ma) {
if ($maf eq '+') {
# If it's a +, change the operator to 1.
$op = 1;
}
elsif ($maf eq '-') {
# If it's a -, change the operator to 2.
$op = 2;
}
else {
# It's a mode, lets check if it's a status mode.
my $nnt = 0;
foreach (keys %{ $csprefix{$svr} }) {
if ($maf eq $_) {
$nnt = 1;
last;
}
}
if ($nnt) {
# It is a status mode, lets parse changes.
my $user = shift(@ex);
if (defined $chanusers{$svr}{$chan}{$user}) {
if ($op == 1) {
if ($chanusers{$svr}{$chan}{$user} eq 1) {
$chanusers{$svr}{$chan}{$user} = $maf;
}
else {
$chanusers{$svr}{$chan}{$user} .= $maf;
}
}
elsif ($op == 2) {
if (length($chanusers{$svr}{$chan}{$user}) == 1) {
$chanusers{$svr}{$chan}{$user} = 1;
}
else {
$chanusers{$svr}{$chan}{$user} =~ s/($maf)//gxsm;
}
}
}
else {
$chanusers{$svr}{$chan}{$user} = $maf;
}
}
else {
# It is not. Lets adjust arguments accordingly.
if (defined $chanmodes{$svr}{$maf}) {
if ($chanmodes{$svr}{$maf} == 1 || $chanmodes{$svr}{$maf} == 2) { shift @ex; }
if ($chanmodes{$svr}{$maf} == 3) {
if ($op == 1) { shift @ex; }
}
}
}
}
}
}
}
return 1;
}
# Parse: NICK
sub nick
{
my ($svr, ($uex, undef, $nex)) = @_;
$nex = substr($nex, 1);
my %src = API::IRC::usrc(substr($uex, 1));
# Check if this is coming from ourselves.
if ($src{nick} eq $botnick{$svr}{nick}) {
# It is. Update bot nick hash.
$botnick{$svr}{nick} = $nex;
delete $botnick{$svr}{newnick} if (defined $botnick{$svr}{newnick});
}
else {
# It isn't. Update chanusers and trigger on_nick.
foreach my $chk (keys %{ $chanusers{$svr} }) {
if (defined $chanusers{$svr}{$chk}{$src{nick}}) {
$chanusers{$svr}{$chk}{$nex} = $chanusers{$svr}{$chk}{$src{nick}};
delete $chanusers{$svr}{$chk}{$src{nick}};
}
}
API::Std::event_run("on_nick", ($svr, \%src, $nex));
}
return 1;
}
# Parse: NOTICE
sub notice
{
my ($svr, @ex) = @_;
# Ensure this is coming from a user rather than a server.
if ($ex[0] !~ m/!/xsm) { return; }
# Prepare all the data.
my %src = API::IRC::usrc(substr $ex[0], 1);
my $target = $ex[2];
shift @ex; shift @ex; shift @ex;
$ex[0] = substr $ex[0], 1;
$src{svr} = $svr;
# Send it off.
API::Std::event_run("on_notice", (\%src, $target, @ex));
return 1;
}
# Parse: PART
sub part
{
my ($svr, @ex) = @_;
my %src = API::IRC::usrc(substr($ex[0], 1));
# Delete them from chanusers.
delete $chanusers{$svr}{$ex[2]}{$src{nick}} if defined $chanusers{$svr}{$ex[2]}{$src{nick}};
# Set $msg to the part message.
my $msg = 0;
if (defined $ex[3]) {
$msg = substr($ex[3], 1);
if (defined $ex[4]) {
for (my $i = 4; $i < scalar(@ex); $i++) {
$msg .= " ".$ex[$i];
}
}
}
# Trigger on_part.
API::Std::event_run("on_part", ($svr, \%src, $ex[2], $msg));
return 1;
}
# Parse: PRIVMSG
sub privmsg
{
my ($svr, @ex) = @_;
my %data = API::IRC::usrc(substr($ex[0], 1));
my @argv;
for (my $i = 4; $i < scalar(@ex); $i++) {
push(@argv, $ex[$i]);
}
$data{svr} = $svr;
my ($cmd, $cprefix, $rprefix);
# Check if it's to a channel or to us.
if (lc($ex[2]) eq lc($botnick{$svr}{nick})) {
# It is coming to us in a private message.
# Ensure it's a valid length.
if (length($ex[3]) > 1) {
$cmd = uc(substr($ex[3], 1));
if (defined $API::Std::CMDS{$cmd}) {
# If this is indeed a command, continue.
if ($API::Std::CMDS{$cmd}{lvl} == 1 or $API::Std::CMDS{$cmd}{lvl} == 2) {
# Ensure the level is private or all.
if (API::Std::ratelimit_check(%data)) {
# Continue if the user has not passed the ratelimit amount.
if ($API::Std::CMDS{$cmd}{priv}) {
# If this command requires a privilege...
if (API::Std::has_priv(API::Std::match_user(%data), $API::Std::CMDS{$cmd}{priv})) {
# Make sure they have it.
&{ $API::Std::CMDS{$cmd}{'sub'} }(\%data, @argv);
}
else {
# Else give them the boot.
API::IRC::notice($data{svr}, $data{nick}, API::Std::trans("Permission denied").".");
}
}
else {
# Else execute the command without any extra checks.
&{ $API::Std::CMDS{$cmd}{'sub'} }(\%data, @argv);
}
}
else {
# Send them a notice about their bad deed.
API::IRC::notice($data{svr}, $data{nick}, trans('Rate limit exceeded').q{.});
}
}
}
}
# Trigger event on_uprivmsg.
shift @ex; shift @ex; shift @ex;
$ex[0] = substr $ex[0], 1;
API::Std::event_run("on_uprivmsg", (\%data, @ex));
}
else {
# It is coming to us in a channel message.
$data{chan} = $ex[2];
# Ensure it's a valid length before continuing.
if (length($ex[3]) > 1) {
$cprefix = (conf_get("fantasy_pf"))[0][0];
$rprefix = substr($ex[3], 1, 1);
$cmd = uc(substr($ex[3], 2));
if (defined $API::Std::CMDS{$cmd} and $rprefix eq $cprefix) {
# If this is indeed a command, continue.
if ($API::Std::CMDS{$cmd}{lvl} == 0 or $API::Std::CMDS{$cmd}{lvl} == 2) {
# Ensure the level is public or all.
if (API::Std::ratelimit_check(%data)) {
# Continue if the user has not passed the ratelimit amount.
if ($API::Std::CMDS{$cmd}{priv}) {
# If this command takes a privilege...
if (API::Std::has_priv(API::Std::match_user(%data), $API::Std::CMDS{$cmd}{priv})) {
# Make sure they have it.
&{ $API::Std::CMDS{$cmd}{'sub'} }(\%data, @argv);
}
else {
# Else give them the boot.
API::IRC::notice($data{svr}, $data{nick}, API::Std::trans("Permission denied").".");
}
}
else {
# Else continue executing without any extra checks.
&{ $API::Std::CMDS{$cmd}{'sub'} }(\%data, @argv) if $rprefix eq $cprefix;
}
}
else {
# Send them a notice about their bad deed.
API::IRC::notice($data{svr}, $data{nick}, trans('Rate limit exceeded').q{.});
}
}
}
}
# Trigger event on_cprivmsg.
my $target = $ex[2]; delete $data{chan};
shift @ex; shift @ex; shift @ex;
$ex[0] = substr $ex[0], 1;
API::Std::event_run("on_cprivmsg", (\%data, $target, @ex));
}
return 1;
}
# Parse: QUIT
sub quit
{
my ($svr, @ex) = @_;
my %src = API::IRC::usrc(substr($ex[0], 1));
# Set $msg to the quit message.
my $msg = 0;
if (defined $ex[2]) {
$msg = substr($ex[2], 1);
if (defined $ex[3]) {
for (my $i = 3; $i < scalar(@ex); $i++) {
$msg .= " ".$ex[$i];
}
}
}
# Trigger on_quit.
API::Std::event_run("on_quit", ($svr, \%src, $msg));
return 1;
}
# Parse: TOPIC
sub topic
{
my ($svr, @ex) = @_;
my %src = API::IRC::usrc(substr($ex[0], 1));
# Ignore it if it's coming from us.
if (lc($src{nick}) ne lc($botnick{$svr}{nick})) {
$src{chan} = $ex[2];
my (@argv);
$argv[0] = substr($ex[3], 1);
if (defined $ex[4]) {
for (my $i = 4; $i < scalar(@ex); $i++) {
push(@argv, $ex[$i]);
}
}
API::Std::event_run("on_topic", ($svr, \%src, @argv));
}
return 1;
}
1;
# vim: set ai sw=4 ts=4:
+4 -4
View File
@@ -13,15 +13,15 @@ sub parse
my ($lang) = @_; my ($lang) = @_;
# Check that the language file exists. # Check that the language file exists.
unless (-e "$Auto::Bin/../lang/$lang.alf") { if (!-e "$Auto::bin{lng}/$lang.alf") {
# Otherwise, use English. # Otherwise, use English.
dbug "Language '$lang' not found. Using English."; dbug "Language '$lang' not found. Using English.";
alog "Language '$lang' not found. Using English."; alog "Language '$lang' not found. Using English.";
$lang = "en"; $lang = 'en';
} }
# Open, read and close the file. # Open, read and close the file.
open(my $FALF, q{<}, "$Auto::Bin/../lang/$lang.alf") or return 0; open(my $FALF, '<', "$Auto::bin{lng}/$lang.alf") or return;
my @fbuf = <$FALF>; my @fbuf = <$FALF>;
close $FALF; close $FALF;
@@ -64,4 +64,4 @@ sub parse
1; 1;
# vim: set ai sw=4 ts=4: # vim: set ai et sw=4 ts=4:
+777
View File
@@ -0,0 +1,777 @@
# lib/Proto/IRC.pm - Subroutines for parsing incoming data from IRC.
# Copyright (C) 2010-2011 Xelhua Development Group, et al.
# This program is free software; rights to this code are stated in doc/LICENSE.
package Proto::IRC;
use strict;
use warnings;
use feature qw(switch);
use API::Std qw(conf_get err awarn trans);
use API::IRC;
# Raw parsing hash.
our %RAWC = (
'001' => \&num001,
'004' => \&num004,
'005' => \&num005,
'352' => \&num352,
'353' => \&num353,
'396' => \&num396,
'432' => \&num432,
'433' => \&num433,
'438' => \&num438,
'465' => \&num465,
'471' => \&num471,
'473' => \&num473,
'474' => \&num474,
'475' => \&num475,
'477' => \&num477,
'CAP' => \&cap,
'JOIN' => \&cjoin,
'KICK' => \&kick,
'MODE' => \&mode,
'NICK' => \&nick,
'NOTICE' => \&notice,
'PART' => \&part,
'PRIVMSG' => \&privmsg,
'QUIT' => \&quit,
'TOPIC' => \&topic,
);
# Variables for various functions.
our (%got_001, %botchans, %csprefix, %chanmodes, %cap);
# Events.
API::Std::event_add('on_capack');
API::Std::event_add('on_cmode');
API::Std::event_add('on_umode');
API::Std::event_add('on_connect');
API::Std::event_add('on_rcjoin');
API::Std::event_add('on_ucjoin');
API::Std::event_add('on_isupport');
API::Std::event_add('on_kick');
API::Std::event_add('on_selfkick');
API::Std::event_add('on_myinfo');
API::Std::event_add('on_namesreply');
API::Std::event_add('on_nick');
API::Std::event_add('on_notice');
API::Std::event_add('on_part');
API::Std::event_add('on_upart');
API::Std::event_add('on_cprivmsg');
API::Std::event_add('on_uprivmsg');
API::Std::event_add('on_quit');
API::Std::event_add('on_topic');
API::Std::event_add('on_whoreply');
# Parse raw data.
sub ircparse
{
my ($svr, $data) = @_;
# Split spaces into @ex.
my @ex = split /\s+/, $data;
# Make sure there is enough data.
if (defined $ex[0] and defined $ex[1]) {
# If it's a ping...
if ($ex[0] eq 'PING') {
# send a PONG.
Auto::socksnd($svr, "PONG $ex[1]");
}
# If it's AUTHENTICATE
elsif ($ex[0] eq 'AUTHENTICATE') {
if (API::Std::mod_exists('SASLAuth')) {
M::SASLAuth::handle_authenticate($svr, @ex);
}
}
# Check if it's handled by core.
elsif (defined $RAWC{$ex[1]}) {
&{ $RAWC{$ex[1]} }($svr, @ex);
}
else {
# otherwise, check for a raw hook.
if (defined $API::Std::RAWHOOKS{$ex[1]}) {
foreach (keys %{$API::Std::RAWHOOKS{$ex[1]}}) {
&{ $API::Std::RAWHOOKS{$ex[1]}{$_} }($svr, @ex);
}
}
}
}
return 1;
}
###########################
# Raw parsing subroutines #
###########################
# Parse: Numeric:001
# Successful connection.
sub num001 {
my ($svr, @ex) = @_;
$got_001{$svr} = 1;
# In case we don't get NICK from the server.
if (!defined $State::IRC::botinfo{$svr}{nick}) {
$State::IRC::botinfo{$svr}{nick} = $State::IRC::botinfo{$svr}{newnick};
delete $State::IRC::botinfo{$svr}{newnick};
}
# Log.
API::Log::alog "! Successfully connected to $svr as $State::IRC::botinfo{$svr}{nick}";
API::Log::dbug "! Successfully connected to $svr as $State::IRC::botinfo{$svr}{nick}";
# Trigger on_connect.
API::Std::event_run('on_connect', $svr);
return 1;
}
# Parse: Numeric:004
# Server information.
sub num004 {
my ($svr, @ex) = @_;
# Log server name and version.
API::Log::alog "! $svr: $ex[3] running version $ex[4]";
API::Log::dbug "! $svr: $ex[3] running version $ex[4]";
# Trigger on_myinfo.
API::Std::event_run('on_myinfo', ($svr, @ex[3..$#ex]));
return 1;
}
# Parse: Numeric:005
# Server ISUPPORT.
sub num005 {
my ($svr, @ex) = @_;
# Trigger on_isupport.
API::Std::event_run('on_isupport', ($svr, @ex[3..$#ex]));
return 1;
}
# Parse: Numeric:352
# WHO reply.
sub num352 {
my ($svr, @ex) = @_;
# Trigger on_whoreply.
$ex[9] =~ s/^://xsm;
API::Std::event_run('on_whoreply', ($svr, $ex[7], $ex[3], $ex[4], $ex[5], $ex[6], $ex[8], $ex[9], @ex[10..$#ex]));
return 1;
}
# Parse: Numeric:353
# NAMES reply.
sub num353 {
my ($svr, @ex) = @_;
# Get rid of the colon.
$ex[5] =~ s/^://xsm;
# Trigger on_namesreply.
API::Std::event_run('on_namesreply', ($svr, $ex[4], @ex[5..$#ex]));
return 1;
}
# Parse: Numeric:396
# Hidden host changed.
sub num396 {
my ($svr, @ex) = @_;
# Update our mask.
$State::IRC::botinfo{$svr}{mask} = $ex[3];
return 1;
}
# Parse: Numeric:432
# Erroneous nickname.
sub num432 {
my ($svr, undef) = @_;
if ($got_001{$svr}) {
err(3, "Got error from server[$svr]: Erroneous nickname.", 0);
}
else {
err(2, "Got error from server[$svr] before connection complete: Erroneous nickname. Closing connection.", 0);
API::IRC::quit($svr, 'An error occurred.');
}
if (defined $State::IRC::botinfo{$svr}{newnick}) { delete $State::IRC::botinfo{$svr}{newnick} }
return 1;
}
# Parse: Numeric:433
# Nickname is already in use.
sub num433 {
my ($svr, undef) = @_;
if (defined $State::IRC::botinfo{$svr}{newnick}) {
API::IRC::nick($svr, $State::IRC::botinfo{$svr}{newnick}.'_');
}
return 1;
}
# Parse: Numeric:438
# Nick change too fast.
sub num438 {
my ($svr, @ex) = @_;
if (defined $State::IRC::botinfo{$svr}{newnick}) {
API::Std::timer_add('num438_'.$State::IRC::botinfo{$svr}{newnick}, 1, $ex[11], sub {
API::IRC::nick($State::IRC::botinfo{$svr}{newnick});
if (defined $State::IRC::botinfo{$svr}{newnick}) { delete $State::IRC::botinfo{$svr}{newnick} }
});
}
return 1;
}
# Parse: Numeric:465
# You're banned creep!
sub num465 {
my ($svr, undef) = @_;
err(3, "Banned from $svr.! Closing link...", 0);
return 1;
}
# Parse: Numeric:471
# Cannot join channel: Channel is full.
sub num471 {
my ($svr, (undef, undef, undef, $chan)) = @_;
err(3, "Cannot join channel $chan on $svr: Channel is full.", 0);
return 1;
}
# Parse: Numeric:473
# Cannot join channel: Channel is invite-only.
sub num473 {
my ($svr, (undef, undef, undef, $chan)) = @_;
err(3, "Cannot join channel $chan on $svr: Channel is invite-only.", 0);
return 1;
}
# Parse: Numeric:474
# Cannot join channel: Banned from channel.
sub num474 {
my ($svr, (undef, undef, undef, $chan)) = @_;
err(3, "Cannot join channel $chan on $svr: Banned from channel.", 0);
return 1;
}
# Parse: Numeric:475
# Cannot join channel: Bad key.
sub num475 {
my ($svr, (undef, undef, undef, $chan)) = @_;
err(3, "Cannot join channel $chan on $svr: Bad key.", 0);
return 1;
}
# Parse: Numeric:477
# Cannot join channel: Need registered nickname.
sub num477 {
my ($svr, (undef, undef, undef, $chan)) = @_;
err(3, "Cannot join channel $chan on $svr: Need registered nickname.", 0);
return 1;
}
# Parse: CAP
sub cap {
my ($svr, @ex) = @_;
my $capout;
# Iterate ex[3].
given ($ex[3]) {
when ('LS') {
# Get our CAP REQ list.
my @capreq = ();
if ($cap{$svr} =~ m/\s/xsm) { @capreq = split ' ', $cap{$svr} }
else { push @capreq, $cap{$svr} }
# Iterate through what we received from the server.
$ex[4] =~ s/^://xsm;
foreach my $scap (@ex[4..$#ex]) {
# Check if we support this.
foreach my $icap (@capreq) {
if ($icap eq $scap) {
$capout .= " $scap";
}
}
}
# Send CAP REQ/CAP END based on what both we and the server support.
if (!$capout) { Auto::socksnd($svr, 'CAP END') }
else {
$capout = substr $capout, 1;
Auto::socksnd($svr, "CAP REQ :$capout");
}
}
when ('ACK') {
# Iterate through the ACK arguments.
$ex[4] =~ s/^://xsm;
my $sasl = 0;
foreach (@ex[4..$#ex]) {
if ($_ eq 'sasl') { $sasl++ }
API::Std::event_run('on_capack', ($svr, $_));
}
Auto::socksnd($svr, 'CAP END') unless $sasl;
}
when ('NAK') {
# This should never happen, but just in case...
API::Log::awarn(2, "$svr: CAP failed: Server refused '$capout'");
Auto::socksnd($svr, 'CAP END');
}
}
return 1;
}
# Parse: JOIN
sub cjoin {
my ($svr, @ex) = @_;
my %src = API::IRC::usrc(substr($ex[0], 1));
my $chan = $ex[2];
$chan =~ s/^://gxsm;
# Check if this is coming from ourselves.
if ($src{nick} eq $State::IRC::botinfo{$svr}{nick}) {
$botchans{$svr}{lc $chan} = 1;
API::Std::event_run("on_ucjoin", ($svr, $chan));
}
else {
# It isn't. Update chanusers and trigger on_rcjoin.
$State::IRC::chanusers{$svr}{lc $chan}{lc $src{nick}} = 1;
$src{svr} = $svr;
API::Std::event_run("on_rcjoin", (\%src, $chan));
}
return 1;
}
# Parse: KICK
sub kick {
my ($svr, @ex) = @_;
my %src = API::IRC::usrc(substr($ex[0], 1));
$src{svr} = $svr;
# Set $msg to the kick message.
my $msg = 0;
if (defined $ex[4]) {
$msg = substr($ex[4], 1);
if (defined $ex[5]) {
for (my $i = 5; $i < scalar(@ex); $i++) {
$msg .= " ".$ex[$i];
}
}
}
# Check if we were the ones kicked.
if (lc($ex[3]) eq lc($State::IRC::botinfo{$svr}{nick})) {
# We were kicked!
# Delete channel from botchans.
delete $botchans{$svr}{lc $ex[2]};
# Log this horrible act.
API::Log::alog("I was kicked from ".$svr."/".$ex[2]." by ".$src{nick}."! Reason: ".$msg);
# Rejoin if we're told to in config.
if (conf_get("server:$svr:autorejoin")) {
if ((conf_get("server:$svr:autorejoin"))[0][0] eq 1) {
API::IRC::cjoin($svr, $ex[2]);
}
}
# Trigger on_selfkick.
API::Std::event_run('on_selfkick', (\%src, $ex[2], $msg));
}
else {
# We weren't. Update chanusers and trigger on_kick.
if (defined $State::IRC::chanusers{$svr}{lc $ex[2]}{lc $ex[3]}) { delete $State::IRC::chanusers{$svr}{lc $ex[2]}{lc $ex[3]} }
API::Std::event_run("on_kick", (\%src, $ex[2], $ex[3], $msg));
}
return 1;
}
# Parse: MODE
sub mode {
my ($svr, @ex) = @_;
if ($ex[2] ne $State::IRC::botinfo{$svr}{nick}) {
# Set data we'll need later.
my $chan = lc $ex[2];
$ex[3] =~ s/^://xsm;
my $modes = $ex[3];
my $fmodes = join ' ', @ex[3..$#ex];
$modes =~ s/^://xsm;
# Get rid of the useless data, so the mode parser will work smoothly.
shift @ex; shift @ex; shift @ex; shift @ex;
# Check if the modes contain any status modes.
my $nt = 0;
foreach (keys %{ $csprefix{$svr} }) {
if ($modes =~ /($_)/) {
$nt = 1;
last;
}
}
if ($nt) {
# It did. Lets parse the changes.
my @ma = split(//, $modes);
my $op = 1;
foreach my $maf (@ma) {
if ($maf eq '+') {
# If it's a +, change the operator to 1.
$op = 1;
}
elsif ($maf eq '-') {
# If it's a -, change the operator to 2.
$op = 2;
}
else {
# It's a mode, lets check if it's a status mode.
my $nnt = 0;
foreach (keys %{ $csprefix{$svr} }) {
if ($maf eq $_) {
$nnt = 1;
last;
}
}
if ($nnt) {
# It is a status mode, lets parse changes.
my $user = lc shift @ex;
if (defined $State::IRC::chanusers{$svr}{$chan}{$user}) {
if ($op == 1) {
return if $State::IRC::chanusers{$svr}{$chan}{$user} =~ m/$maf/xsm;
if ($State::IRC::chanusers{$svr}{$chan}{$user} eq 1) {
$State::IRC::chanusers{$svr}{$chan}{$user} = $maf;
}
else {
$State::IRC::chanusers{$svr}{$chan}{$user} .= $maf;
}
}
elsif ($op == 2) {
if (length($State::IRC::chanusers{$svr}{$chan}{$user}) == 1) {
$State::IRC::chanusers{$svr}{$chan}{$user} = 1;
}
else {
$State::IRC::chanusers{$svr}{$chan}{$user} =~ s/($maf)//gxsm;
}
}
}
else {
$State::IRC::chanusers{$svr}{$chan}{$user} = $maf;
}
}
else {
# It is not. Lets adjust arguments accordingly.
if (defined $chanmodes{$svr}{$maf}) {
if ($chanmodes{$svr}{$maf} == 1 || $chanmodes{$svr}{$maf} == 2) { shift @ex }
if ($chanmodes{$svr}{$maf} == 3) {
if ($op == 1) { shift @ex }
}
}
}
}
}
}
# Trigger on_cmode.
API::Std::event_run('on_cmode', ($svr, $chan, $fmodes));
}
else {
# User mode change; trigger on_umode.
$ex[3] =~ s/^://xsm;
API::Std::event_run('on_umode', ($svr, @ex[3..$#ex]));
}
return 1;
}
# Parse: NICK
sub nick {
my ($svr, ($uex, undef, $nex)) = @_;
$nex =~ s/^://gxsm;
my %src = API::IRC::usrc(substr($uex, 1));
$src{svr} = $svr;
# Check if this is coming from ourselves.
if ($src{nick} eq $State::IRC::botinfo{$svr}{nick}) {
# It is. Update bot nick hash.
$State::IRC::botinfo{$svr}{nick} = $nex;
delete $State::IRC::botinfo{$svr}{newnick} if (defined $State::IRC::botinfo{$svr}{newnick});
}
else {
# It isn't. Update chanusers and trigger on_nick.
foreach my $chk (keys %{ $State::IRC::chanusers{$svr} }) {
if (defined $State::IRC::chanusers{$svr}{$chk}{lc $src{nick}}) {
$State::IRC::chanusers{$svr}{$chk}{lc $nex} = $State::IRC::chanusers{$svr}{$chk}{lc $src{nick}};
delete $State::IRC::chanusers{$svr}{$chk}{lc $src{nick}};
}
}
API::Std::event_run("on_nick", (\%src, $nex));
}
return 1;
}
# Parse: NOTICE
sub notice {
my ($svr, @ex) = @_;
# Ensure this is coming from a user rather than a server.
if ($ex[0] !~ m/!/xsm) { return }
# Prepare all the data.
my %src = API::IRC::usrc(substr $ex[0], 1);
my $target = $ex[2];
shift @ex; shift @ex; shift @ex;
$ex[0] = substr $ex[0], 1;
$src{svr} = $svr;
# Send it off.
API::Std::event_run("on_notice", (\%src, $target, @ex));
return 1;
}
# Parse: PART
sub part {
my ($svr, @ex) = @_;
my %src = API::IRC::usrc(substr($ex[0], 1));
$src{svr} = $svr;
# Check if it's from us or someone else.
if ($src{nick} eq $State::IRC::botinfo{$svr}{nick}) {
# Delete this channel from botchans.
if ($botchans{$svr}{lc $ex[2]}) { delete $botchans{$svr}{lc $ex[2]} }
# Trigger on_upart.
API::Std::event_run('on_upart', ($svr, $ex[2]));
}
else {
# Delete them from chanusers.
delete $State::IRC::chanusers{$svr}{lc $ex[2]}{lc $src{nick}} if defined $State::IRC::chanusers{$svr}{lc $ex[2]}{lc $src{nick}};
# Set $msg to the part message.
my $msg = 0;
if (defined $ex[3]) {
$msg = substr($ex[3], 1);
if (defined $ex[4]) {
for (my $i = 4; $i < scalar(@ex); $i++) {
$msg .= " ".$ex[$i];
}
}
}
# Trigger on_part.
API::Std::event_run("on_part", (\%src, $ex[2], $msg));
}
return 1;
}
# Parse: PRIVMSG
sub privmsg {
my ($svr, @ex) = @_;
my %data;
# Ensure this is coming from a user rather than a server.
if ($ex[0] !~ m/!/xsm) {
%data = (
'nick' => substr($ex[0], 1),
'user' => '*',
'host' => '*'
);
}
else { %data = API::IRC::usrc(substr($ex[0], 1)) }
my @argv;
for (my $i = 4; $i < scalar(@ex); $i++) {
push(@argv, $ex[$i]);
}
$data{svr} = $svr;
my ($cmd, $cprefix, $rprefix);
# Check if it's to a channel or to us.
if (lc($ex[2]) eq lc($State::IRC::botinfo{$svr}{nick})) {
# It is coming to us in a private message.
# Check for a prefix.
$cprefix = (conf_get('fantasy_pf'))[0][0];
# Ensure it's a valid length.
if (length($ex[3]) > 2) {
$cmd = uc substr $ex[3], 1;
if (substr($cmd, 0, 1) eq $cprefix) { $cmd = substr $cmd, 1 }
if (defined $API::Std::CMDS{$cmd}) {
# If this is indeed a command, continue.
if ($API::Std::CMDS{$cmd}{lvl} == 1 or $API::Std::CMDS{$cmd}{lvl} == 2) {
# Ensure the level is private or all.
if (API::Std::ratelimit_check(%data)) {
# Continue if the user has not passed the ratelimit amount.
if ($API::Std::CMDS{$cmd}{priv}) {
# If this command requires a privilege...
if (API::Std::has_priv(API::Std::match_user(%data), $API::Std::CMDS{$cmd}{priv})) {
# Make sure they have it.
&{ $API::Std::CMDS{$cmd}{'sub'} }(\%data, @argv);
}
else {
# Else give them the boot.
API::IRC::notice($data{svr}, $data{nick}, API::Std::trans("Permission denied").".");
}
}
else {
# Else execute the command without any extra checks.
&{ $API::Std::CMDS{$cmd}{'sub'} }(\%data, @argv);
}
}
else {
# Send them a notice about their bad deed.
API::IRC::notice($data{svr}, $data{nick}, trans('Rate limit exceeded').q{.});
}
}
}
}
# Trigger event on_uprivmsg.
shift @ex; shift @ex; shift @ex;
$ex[0] = substr $ex[0], 1;
API::Std::event_run("on_uprivmsg", (\%data, @ex));
}
else {
# It is coming to us in a channel message.
$data{chan} = $ex[2];
# Ensure it's a valid length before continuing.
if (length($ex[3]) > 1) {
$cprefix = (conf_get("fantasy_pf"))[0][0];
$rprefix = substr($ex[3], 1, 1);
$cmd = uc(substr($ex[3], 2));
if (defined $API::Std::CMDS{$cmd} and $rprefix eq $cprefix) {
# If this is indeed a command, continue.
if ($API::Std::CMDS{$cmd}{lvl} == 0 or $API::Std::CMDS{$cmd}{lvl} == 2) {
# Ensure the level is public or all.
if (API::Std::ratelimit_check(%data)) {
# Continue if the user has not passed the ratelimit amount.
if ($API::Std::CMDS{$cmd}{priv}) {
# If this command takes a privilege...
if (API::Std::has_priv(API::Std::match_user(%data), $API::Std::CMDS{$cmd}{priv})) {
# Make sure they have it.
&{ $API::Std::CMDS{$cmd}{'sub'} }(\%data, @argv);
}
else {
# Else give them the boot.
API::IRC::notice($data{svr}, $data{nick}, API::Std::trans('Permission denied').q{.});
}
}
else {
# Else continue executing without any extra checks.
&{ $API::Std::CMDS{$cmd}{'sub'} }(\%data, @argv);
}
}
else {
# Send them a notice about their bad deed.
API::IRC::notice($data{svr}, $data{nick}, trans('Rate limit exceeded').q{.});
}
}
elsif ($API::Std::CMDS{$cmd}{lvl} == 3) {
# Or if it's a logchan command...
my ($lcn, $lcc) = split '/', (conf_get('logchan'))[0][0];
if ($lcn eq $data{svr} and lc $lcc eq lc $data{chan}) {
# Check if it's being sent from the logchan.
if ($API::Std::CMDS{$cmd}{priv}) {
# If this command takes a privilege...
if (API::Std::has_priv(API::Std::match_user(%data), $API::Std::CMDS{$cmd}{priv})) {
# Make sure they have it.
&{ $API::Std::CMDS{$cmd}{'sub'} }(\%data, @argv);
}
else {
# Else give them the boot.
API::IRC::notice($data{svr}, $data{nick}, API::Std::trans('Permission denied').q{.});
}
}
else {
# Else continue executing without any extra checks.
&{ $API::Std::CMDS{$cmd}{'sub'} }(\%data, @argv);
}
}
}
}
}
# Trigger event on_cprivmsg.
my $target = $ex[2]; delete $data{chan};
shift @ex; shift @ex; shift @ex;
$ex[0] = substr $ex[0], 1;
API::Std::event_run("on_cprivmsg", (\%data, $target, @ex));
}
return 1;
}
# Parse: QUIT
sub quit {
my ($svr, @ex) = @_;
my %src = API::IRC::usrc(substr($ex[0], 1));
$src{svr} = $svr;
# Set $msg to the quit message.
my $msg = 0;
if (defined $ex[2]) {
$msg = substr($ex[2], 1);
if (defined $ex[3]) {
for (my $i = 3; $i < scalar(@ex); $i++) {
$msg .= " ".$ex[$i];
}
}
}
# Trigger on_quit.
API::Std::event_run("on_quit", (\%src, $msg));
return 1;
}
# Parse: TOPIC
sub topic {
my ($svr, @ex) = @_;
my %src = API::IRC::usrc(substr($ex[0], 1));
$src{svr} = $svr;
$src{chan} = $ex[2];
$ex[3] = substr $ex[3], 1;
# Trigger on_topic.
API::Std::event_run('on_topic', (\%src, @ex[3..$#ex]));
return 1;
}
1;
# vim: set ai et sw=4 ts=4:
+50
View File
@@ -0,0 +1,50 @@
# lib/State/IRC.pm - IRC state data.
# Copyright (C) 2010-2011 Xelhua Development Group, et al.
# This program is free software; rights to this code are stated in doc/LICENSE.
package State::IRC;
use strict;
use warnings;
use API::Std qw(hook_add);
our (%chanusers, %botinfo);
# Create on_namesreply hook.
hook_add('on_namesreply', 'state.irc.names', sub {
my ($svr, $chan, @data) = @_;
$chan = lc $chan;
# Delete the old chanusers hash if it exists.
if (defined $chanusers{$svr}{$chan}) { delete $chanusers{$svr}{$chan} }
# Iterate through each user.
for (1..$#data) {
my $fi = 0;
PFITER: foreach my $spfx (keys %{ $Proto::IRC::csprefix{$svr} }) {
# Check if the user has status in the channel.
if (substr($data[$_], 0, 1) eq $Proto::IRC::csprefix{$svr}{$spfx}) {
# He/she does. Lets set that.
if (defined $chanusers{$svr}{$chan}{lc $data[$_]}) {
# If the user has multiple statuses.
$chanusers{$svr}{$chan}{lc substr $data[$_], 1} = $chanusers{$svr}{$chan}{lc $data[$_]}.$spfx;
delete $chanusers{$svr}{$chan}{lc $data[$_]};
}
else {
# Or not.
$chanusers{$svr}{$chan}{lc substr $data[$_], 1} = $spfx;
}
$fi = 1;
$data[$_] = substr $data[$_], 1;
}
}
# Check if there's still a prefix.
foreach my $spfx (keys %{$Proto::IRC::csprefix{$svr}}) {
if (substr($data[$_], 0, 1) eq $Proto::IRC::csprefix{$svr}{$spfx}) { goto 'PFITER' }
}
# They had status, so go to the next user.
next if $fi;
# They didn't, set them as a normal user.
if (!defined $chanusers{$svr}{$chan}{lc $data[$_]}) {
$chanusers{$svr}{$chan}{lc $data[$_]} = 1;
}
}
return 1;
});
+120
View File
@@ -0,0 +1,120 @@
# Module: AUR. See below for documentation.
# Copyright (C) 2010-2011 Xelhua Development Group, et al.
# This program is free software; rights to this code are stated in doc/LICENSE.
package M::AUR;
use strict;
use warnings;
use WWW::AUR;
use API::Std qw(cmd_add cmd_del trans);
use API::IRC qw(notice privmsg);
# Initialization subroutine.
sub _init {
# Create the AUR command.
cmd_add('AUR', 0, 0, \%M::AUR::HELP_AUR, \&M::AUR::cmd_aur) or return;
# Success.
return 1;
}
# Void subroutine.
sub _void {
# Delete the AUR command.
cmd_del('AUR') or return;
# Success.
return 1;
}
# Help hash for AUR. Spanish and French translations needed.
our %HELP_AUR = (
en => "This command allows you to lookup a module in the Arch Linux AUR. \2Syntax:\2 AUR <module>",
de => "Dieser Befehl ermoeglicht du auf nachschlagst ein Modul in der Arch Linux AUR. \2Syntax:\2 AUR <module>",
fr => "Cette commande vous permet de rechercher un module dans le Arch Linux AUR. \2Syntaxe:\2 AUR <module>",
);
# Callback for AUR command.
sub cmd_aur {
my ($src, ($mod)) = @_;
# Check for needed parameters.
if (!defined $mod) {
notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.});
return;
}
# Create an instance of WWW::AUR.
my $aur = WWW::AUR->new;
# Create an instance of WWW::AUR::Package.
my $pkg = $aur->find($mod);
# Check if there was a result.
if (defined $pkg) {
# Return the results.
privmsg($src->{svr}, $src->{chan}, "Results for \2$mod\2:");
privmsg($src->{svr}, $src->{chan}, 'ID: '.$pkg->id.' | Name: '.$pkg->name.' | Version: '.$pkg->version);
privmsg($src->{svr}, $src->{chan}, 'Maintainer: '.$pkg->maintainer->name);
privmsg($src->{svr}, $src->{chan}, 'URL: https://aur.archlinux.org/packages.php?ID='.$pkg->id);
}
else {
# Else return no results.
privmsg($src->{svr}, $src->{chan}, "No results for \2$mod\2.");
}
return 1;
}
# Start initialization.
API::Std::mod_init('AUR', 'Xelhua', '1.00', '3.0.0a10');
# build: cpan=WWW::AUR perl=5.010000
__END__
=head1 NAME
AUR - AUR package information module.
=head1 VERSION
1.00
=head1 SYNOPSIS
<JohnSmith> !aur autobot-git
<Auto> Results for autobot-git:
<Auto> ID: 47329 Name: autobot-git Version: 20110311-1
<Auto> Maintainer: iElijah101
<Auto> URL: https://aur.archlinux.org/packages.php?ID=47329
=head1 DESCRIPTION
This module adds a command to allow getting information on a package in the
Arch User Repository at https://aur.archlinux.org.
=head1 DEPENDENCIES
This module is dependent on the following modules from CPAN:
=over
=item L<WWW::AUR>
Interface to the Arch User Repository.
=back
=head1 AUTHOR
This module was written by Matthew Barksdale.
This module is maintained by Xelhua Development Group.
=head1 LICENSE AND COPYRIGHT
This module is Copyright 2010-2011 Xelhua Development Group.
Released under the same licensing terms as Auto itself.
=cut
# vim: set ai et sw=4 ts=4:
+5 -4
View File
@@ -27,7 +27,7 @@ sub _init
sub _void sub _void
{ {
# Delete the act_on_badword hook. # Delete the act_on_badword hook.
hook_del('act_on_badword') or return 0; hook_del('act_on_badword') or return;
# Success. # Success.
return 1; return 1;
@@ -70,8 +70,7 @@ sub actonbadword
} }
API::Std::mod_init('Badwords', 'Xelhua', '1.00', '3.0.0a4', __PACKAGE__); API::Std::mod_init('Badwords', 'Xelhua', '1.00', '3.0.0a10');
# vim: set ai sw=4 ts=4:
# build: perl=5.010000 # build: perl=5.010000
__END__ __END__
@@ -122,6 +121,8 @@ Changing the obvious to your wish.
=over =over
This module is compatible with Auto version 3.0.0a4+. This module is compatible with Auto version 3.0.0a10+.
=back =back
# vim: set ai et sw=4 ts=4:
+22 -19
View File
@@ -13,13 +13,13 @@ use URI::Escape;
sub _init sub _init
{ {
# Check for required configuration values. # Check for required configuration values.
if (!(conf_get('bitly:user'))[0][0] or !(conf_get('bitly:key'))[0][0]) { if (!conf_get('bitly:user') or !conf_get('bitly:key')) {
err(2, "Please verify that you have bitly_user and bitly_key defined in your configuration file.", 0); err(2, 'Bitly: Please verify that you have bitly_user and bitly_key defined in your configuration file.', 0);
return 0; return;
} }
# Create the SHORTEN and REVERSE commands. # Create the SHORTEN and REVERSE commands.
cmd_add("SHORTEN", 0, 0, \%M::Bitly::HELP_SHORTEN, \&M::Bitly::shorten) or return 0; cmd_add('SHORTEN', 0, 0, \%M::Bitly::HELP_SHORTEN, \&M::Bitly::shorten) or return;
cmd_add("REVERSE", 0, 0, \%M::Bitly::HELP_REVERSE, \&M::Bitly::reverse) or return 0; cmd_add('REVERSE', 0, 0, \%M::Bitly::HELP_REVERSE, \&M::Bitly::reverse) or return;
# Success. # Success.
return 1; return 1;
@@ -29,8 +29,8 @@ sub _init
sub _void sub _void
{ {
# Delete the SHORTEN and REVERSE commands. # Delete the SHORTEN and REVERSE commands.
cmd_del("SHORTEN") or return 0; cmd_del('SHORTEN') or return;
cmd_del("REVERSE") or return 0; cmd_del('REVERSE') or return;
# Success. # Success.
return 1; return 1;
@@ -38,10 +38,12 @@ sub _void
# Help hashes. # Help hashes.
our %HELP_SHORTEN = ( our %HELP_SHORTEN = (
'en' => "This command will shorten an URL using Bit.ly. \002Syntax:\002 SHORTEN <url>", en => "This command will shorten an URL using Bit.ly. \2Syntax:\2 SHORTEN <url>",
de => "Dieser Befehl wird eine URL verkuerzen. \2Syntax:\2 SHORTEN <url>",
); );
our %HELP_REVERSE = ( our %HELP_REVERSE = (
'en' => "This command will expand a Bit.ly URL. \002Syntax:\002 REVERSE <url>", en => "This command will expand a Bit.ly URL. \2Syntax:\2 REVERSE <url>",
de => "Dieser Befehl wird eine URL erweitern. \2Syntax:\2 REVERSE <url>",
); );
# Callback for SHORTEN command. # Callback for SHORTEN command.
@@ -56,8 +58,8 @@ sub shorten
# Put together the call to the Bit.ly API. # Put together the call to the Bit.ly API.
if (!defined $args[0]) { if (!defined $args[0]) {
notice($src->{svr}, $src->{nick}, trans("Not enough parameters")."."); notice($src->{svr}, $src->{nick}, trans('Not enough parameters').".");
return 0; return;
} }
my ($surl, $user, $key) = ($args[0], (conf_get('bitly:user'))[0][0], (conf_get('bitly:key'))[0][0]); my ($surl, $user, $key) = ($args[0], (conf_get('bitly:user'))[0][0], (conf_get('bitly:key'))[0][0]);
$surl = uri_escape($surl); $surl = uri_escape($surl);
@@ -74,7 +76,7 @@ sub shorten
} }
else { else {
# Otherwise, send an error message. # Otherwise, send an error message.
privmsg($src->{svr}, $src->{chan}, "An error occurred while shortening your URL."); privmsg($src->{svr}, $src->{chan}, 'An error occurred while shortening your URL.');
} }
return 1; return 1;
@@ -92,8 +94,8 @@ sub reverse
# Put together the call to the Bit.ly API. # Put together the call to the Bit.ly API.
if (!defined $args[0]) { if (!defined $args[0]) {
notice($src->{svr}, $src->{nick}, trans("Not enough parameters")."."); notice($src->{svr}, $src->{nick}, trans('Not enough parameters').".");
return 0; return;
} }
my ($surl, $user, $key) = ($args[0], (conf_get('bitly:user'))[0][0], (conf_get('bitly:key'))[0][0]); my ($surl, $user, $key) = ($args[0], (conf_get('bitly:user'))[0][0], (conf_get('bitly:key'))[0][0]);
$surl = uri_escape($surl); $surl = uri_escape($surl);
@@ -110,7 +112,7 @@ sub reverse
} }
else { else {
# Otherwise, send an error message. # Otherwise, send an error message.
privmsg($src->{svr}, $src->{chan}, "An error occurred while reversing your URL."); privmsg($src->{svr}, $src->{chan}, 'An error occurred while reversing your URL.');
} }
return 1; return 1;
@@ -118,8 +120,7 @@ sub reverse
# Start initialization. # Start initialization.
API::Std::mod_init('Bitly', 'Xelhua', '1.00', '3.0.0a4', __PACKAGE__); API::Std::mod_init('Bitly', 'Xelhua', '1.00', '3.0.0a10');
# vim: set ai sw=4 ts=4:
# build: cpan=LWP::UserAgent,URI::Escape perl=5.010000 # build: cpan=LWP::UserAgent,URI::Escape perl=5.010000
__END__ __END__
@@ -168,7 +169,7 @@ Add Bitly to module auto-load and the following to your configuration file:
=over =over
* Add Spanish, French and German translations for the help hashes. * Add Spanish and German translations for the help hashes.
=back =back
@@ -179,6 +180,8 @@ Add Bitly to module auto-load and the following to your configuration file:
This module adds extra dependencies: LWP::UserAgent and URI::Escape. You can This module adds extra dependencies: LWP::UserAgent and URI::Escape. You can
get it from the CPAN <http://www.cpan.org>. get it from the CPAN <http://www.cpan.org>.
This module is compatible with Auto version 3.0.0a4+. This module is compatible with Auto version 3.0.0a10+.
=back =back
# vim: set ai et sw=4 ts=4:
+116
View File
@@ -0,0 +1,116 @@
# Module: BotStats. See below for documentation.
# Copyright (C) 2010-2011 Xelhua Development Group, et al.
# This program is free software; rights to this code are stated in doc/LICENSE.
package M::BotStats;
use strict;
use warnings;
use English qw(-no_match_vars);
use API::Std qw(cmd_add cmd_del);
use API::IRC qw(privmsg);
# Initialization subroutine.
sub _init {
# Create the STATS command.
cmd_add('STATS', 2, 0, \%M::BotStats::HELP_STATS, \&M::BotStats::stats) or return;
# Success.
return 1;
}
# Void subroutine.
sub _void {
# Delete the STATS command.
cmd_del('STATS') or return;
# Success.
return 1;
}
# Help hash for STATS. Spanish, German and French translations needed.
our %HELP_STATS = (
'en' => "This command will return information about the bot (uptime, version, etc.). \2Syntax:\2 STATS",
);
# Callback for STATS command.
sub stats {
my ($src, undef) = @_;
# Check if this was private or public.
my $target;
if ($src->{chan}) {
$target = $src->{chan};
}
else {
$target = $src->{nick};
}
# Get uptime data.
my $uptime = time - $Auto::STARTTIME;
my $days = my $hours = my $mins = my $secs = 0;
while ($uptime >= 86_400) { $days++; $uptime -= 86_400 }
while ($uptime >= 3_600) { $hours++; $uptime -= 3_600 }
while ($uptime >= 60) { $mins++; $uptime -= 60 }
while ($uptime >= 1) { $secs++; $uptime-- }
# Return it.
privmsg($src->{svr}, $target, "I have been running for \2$days\2 days, \2$hours\2 hours, \2$mins\2 minutes, and \2$secs\2 seconds.");
# Return version data.
privmsg($src->{svr}, $target, 'I am running '.Auto::NAME.' (version '.Auto::VER.q{.}.Auto::SVER.q{.}.Auto::REV.Auto::RSTAGE.") for Perl $PERL_VERSION on $OSNAME.");
# Get network and channel data.
my $nets = keys %Auto::SOCKET;
my $chans;
foreach my $net (keys %Auto::SOCKET) {
foreach (keys %{$Proto::IRC::botchans{$net}}) { $chans++ }
}
# Return network/channel data.
privmsg($src->{svr}, $target, "I am on \2$chans\2 channels across \2$nets\2 networks.");
return 1;
}
API::Std::mod_init('BotStats', 'Xelhua', '1.00', '3.0.0a10');
# build: perl=5.010000
__END__
=head1 NAME
BotStats - General information about the bot
=head1 VERSION
1.00
=head1 SYNOPSIS
<starcoder> !stats
<blue> I have been running for 0 days, 0 hours, 1 minutes, and 5 seconds.
<blue> I am running Auto IRC Bot (version 3.0.0a10) for Perl v5.12.3 on linux.
<blue> I am on 2 channels, across 1 networks.
=head1 DESCRIPTION
This module creates the STATS command, for returning general information about
the bot such as uptime, version, etc.
This module is compatible with Auto v3.0.0a10+.
=head1 AUTHOR
This module was written by Elijah Perrault.
This module is maintained by Xelhua Development Group.
=head1 LICENSE AND COPYRIGHT
This module is Copyright 2010-2011 Xelhua Development Group.
This module is released under the same licensing terms as Auto itself.
=cut
# vim: set ai et sw=4 ts=4:
+10 -8
View File
@@ -14,7 +14,7 @@ use JSON -support_by_pp;
sub _init sub _init
{ {
# Create the CALC command. # Create the CALC command.
cmd_add("CALC", 0, 0, \%M::Calc::HELP_CALC, \&M::Calc::calc) or return 0; cmd_add("CALC", 0, 0, \%M::Calc::HELP_CALC, \&M::Calc::calc) or return;
# Success. # Success.
return 1; return 1;
@@ -24,7 +24,7 @@ sub _init
sub _void sub _void
{ {
# Delete the CALC command. # Delete the CALC command.
cmd_del("CALC") or return 0; cmd_del("CALC") or return;
# Success. # Success.
return 1; return 1;
@@ -32,7 +32,8 @@ sub _void
# Help hash. # Help hash.
our %FHELP_CALC = ( our %FHELP_CALC = (
'en' => "This command will calculate an expression using Google Calculator. \002Syntax:\002 CALC <expression>", en => "This command will calculate an expression using Google Calculator. \2Syntax:\2 CALC <expression>",
de => "Dieser Befehl berechnet einen Ausdruck mit den Google Rechner. \2Syntax:\2 CALC <expression>",
); );
# Callback for CALC command. # Callback for CALC command.
@@ -49,7 +50,7 @@ sub calc
# Put together the call to the Google Calculator API. # Put together the call to the Google Calculator API.
if (!defined $args[0]) { if (!defined $args[0]) {
notice($src->{svr}, $src->{nick}, trans("Not enough parameters")."."); notice($src->{svr}, $src->{nick}, trans("Not enough parameters").".");
return 0; return;
} }
my $expr = join(' ', @args); my $expr = join(' ', @args);
my $url = "http://www.google.com/ig/calculator?q=".uri_escape($expr); my $url = "http://www.google.com/ig/calculator?q=".uri_escape($expr);
@@ -78,8 +79,7 @@ sub calc
} }
# Start initialization. # Start initialization.
API::Std::mod_init('Calc', 'Xelhua', '1.00', '3.0.0a4', __PACKAGE__); API::Std::mod_init('Calc', 'Xelhua', '1.00', '3.0.0a10');
# vim: set ai sw=4 ts=4:
# build: cpan=LWP::UserAgent,URI::Escape,JSON,JSON::PP perl=5.010000 # build: cpan=LWP::UserAgent,URI::Escape,JSON,JSON::PP perl=5.010000
__END__ __END__
@@ -108,7 +108,7 @@ Google Calculator.
=over =over
* Add Spanish, French and German translations for the help hash. * Add Spanish and French translations for the help hash.
=back =back
@@ -119,6 +119,8 @@ Google Calculator.
This module requires LWP::UserAgent, URI::Escape and JSON/JSON::PP. This module requires LWP::UserAgent, URI::Escape and JSON/JSON::PP.
All are obtainable from the CPAN <http://www.cpan.org>. All are obtainable from the CPAN <http://www.cpan.org>.
This module is compatible with Auto version 3.0.0a4+. This module is compatible with Auto version 3.0.0a10+.
=back =back
# vim: set ai et sw=4 ts=4:
+5 -4
View File
@@ -11,7 +11,7 @@ use API::IRC qw(notice topic);
sub _init sub _init
{ {
# PostgreSQL is not supported. # PostgreSQL is not supported.
if ($Auto::ENFEAT =~ /pgsql/) { err(3, 'Unable to load ChanTopics: PostgreSQL is not supported.', 0); return; } if ($Auto::ENFEAT =~ /pgsql/) { err(3, 'Unable to load ChanTopics: PostgreSQL is not supported.', 0); return }
# Create database table if it's missing. # Create database table if it's missing.
$Auto::DB->do('CREATE TABLE IF NOT EXISTS topics (net TEXT, chan TEXT, topic TEXT, divider TEXT, owner TEXT, verb TEXT, status TEXT, other TEXT, static TEXT)') or print "$!\n" and return; $Auto::DB->do('CREATE TABLE IF NOT EXISTS topics (net TEXT, chan TEXT, topic TEXT, divider TEXT, owner TEXT, verb TEXT, status TEXT, other TEXT, static TEXT)') or print "$!\n" and return;
@@ -282,8 +282,7 @@ sub _getdata
} }
API::Std::mod_init('ChanTopics', 'Xelhua', '1.00', '3.0.0a4', __PACKAGE__); API::Std::mod_init('ChanTopics', 'Xelhua', '1.00', '3.0.0a10');
# vim: set ai sw=4 ts=4:
# build: perl=5.010000 # build: perl=5.010000
__END__ __END__
@@ -338,8 +337,10 @@ This module adds no extra dependencies.
This module is not compatible with PostgreSQL, yet. This module is not compatible with PostgreSQL, yet.
This module is compatible with Auto v3.0.0a4+. This module is compatible with Auto v3.0.0a10+.
Ported from v1.0. Ported from v1.0.
=back =back
# vim: set ai et sw=4 ts=4:
+6 -4
View File
@@ -31,7 +31,8 @@ sub _void
# Help hash for DICT. Spanish, French and German translations needed. # Help hash for DICT. Spanish, French and German translations needed.
our %HELP_DICT = ( our %HELP_DICT = (
'en' => "This command allows you to lookup a word through Dict.org. \002Syntax:\002 DICT <word>", en => "This command allows you to lookup a word through Dict.org. \2Syntax:\2 DICT <word>",
de => "Dieser Befehl ermoeglicht du auf nachschlagst ein Wort durch Dict.org. \2Syntax:\2 DICT <word>",
); );
# Callback for DICT command. # Callback for DICT command.
@@ -75,8 +76,7 @@ sub cmd_dict
# Start initialization. # Start initialization.
API::Std::mod_init('Dictionary', 'Xelhua', '1.00', '3.0.0a4', __PACKAGE__); API::Std::mod_init('Dictionary', 'Xelhua', '1.00', '3.0.0a10');
# vim: set ai sw=4 ts=4:
# build: cpan=Net::Dict perl=5.010000 # build: cpan=Net::Dict perl=5.010000
__END__ __END__
@@ -99,6 +99,8 @@ DICT command.
This module adds an extra dependency: Net::Dict. You can get it from the CPAN This module adds an extra dependency: Net::Dict. You can get it from the CPAN
<http://www.cpan.org>. <http://www.cpan.org>.
This module is compatible with Auto v3.0.0a4+. This module is compatible with Auto v3.0.0a10+.
=back =back
# vim: set ai et sw=4 ts=4:
+65 -69
View File
@@ -4,28 +4,40 @@
package M::EightBall; package M::EightBall;
use strict; use strict;
use warnings; use warnings;
use feature qw(switch);
use API::Std qw(cmd_add cmd_del trans); use API::Std qw(cmd_add cmd_del trans);
use API::IRC qw(privmsg notice); use API::IRC qw(privmsg notice);
our $ANSWER = 0; our $ANSWER = 0;
my @responses = (
'Yes!',
'No!',
'Yes... No... Yes... No... Hmm... No.',
'Hmm... it seems likely.',
'Very unlikely.',
'Heck no!',
'Definite yes!',
'Magic unavailable. Try again later.',
'Possibly, I wouldn\'t count on it though.',
'Outcome looks bad.',
'Outcome looks good.',
'Can\'t tell now. Maybe another time.',
'Sorry, but no.',
);
# Initialization subroutine. # Initialization subroutine.
sub _init sub _init {
{
# Create the 8BALL and RIGBALL commands. # Create the 8BALL and RIGBALL commands.
cmd_add('8BALL', 0, 0, \%M::EightBall::HELP_8BALL, \&M::EightBall::c_8ball) or return 0; cmd_add('8BALL', 0, 0, \%M::EightBall::HELP_8BALL, \&M::EightBall::c_8ball) or return;
cmd_add('RIGBALL', 1, 'cmd.rigball', \%M::EightBall::HELP_RIGBALL, \&M::EightBall::rigball) or return 0; cmd_add('RIGBALL', 1, 'cmd.rigball', \%M::EightBall::HELP_RIGBALL, \&M::EightBall::rigball) or return;
# Success. # Success.
return 1; return 1;
} }
# Void subroutine. # Void subroutine.
sub _void sub _void {
{
# Delete the 8BALL and RIGBALL commands. # Delete the 8BALL and RIGBALL commands.
cmd_del('8BALL') or return 0; cmd_del('8BALL') or return;
cmd_del('RIGBALL') or return 0; cmd_del('RIGBALL') or return;
# Success. # Success.
return 1; return 1;
@@ -33,118 +45,102 @@ sub _void
# Help hashes. # Help hashes.
our %HELP_8BALL = ( our %HELP_8BALL = (
'en' => "This command will ask the magic 8-Ball your question. \002Syntax:\002 8BALL <question>", en => "This command will ask the magic 8-Ball your question. \2Syntax:\2 8BALL <question>",
de => "Dieser Befehl fragt die magische 8-Kugel eine Frage. \2Syntax:\2 8BALL <question>",
); );
our %HELP_RIGBALL = ( our %HELP_RIGBALL = (
'en' => "This command will \"rig\" (set) the answer of the next 8-Ball question. \002Syntax:\002 RIGBALL <answer>", en => "This command will \"rig\" (set) the answer of the next 8-Ball question. \2Syntax:\2 RIGBALL <answer>",
de => "Dieser Befehl wird festgelegt die Antwort der naechsten 8-Kugel Frage. \2Syntax:\2 RIGBALL <answer>",
); );
# Callback for 8BALL command. # Callback for 8BALL command.
sub c_8ball sub c_8ball {
{
my ($src, @argv) = @_; my ($src, @argv) = @_;
if (!defined $argv[0]) { if (!defined $argv[0]) {
notice($src->{svr}, $src->{nick}, trans("Not enough parameters")."."); notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.});
return; return;
} }
privmsg($src->{svr}, $src->{chan}, "\002Question:\002 ".join(" ", @argv)); # Return the question.
privmsg($src->{svr}, $src->{chan}, "\2Question:\2 ".join q{ }, @argv);
my $a = ''; # Set answer.
my $answer;
if (!$ANSWER) { if (!$ANSWER) {
my $rn = int(rand(12)); $answer = $responses[int rand scalar @responses];
given ($rn) {
when (1) { $a = "Yes!"; }
when (2) { $a = "No!"; }
when (3) { $a = "Yes... No... Yes... No... No."; }
when (4) { $a = "Hmm... it seems likely."; }
when (5) { $a = "Very unlikely."; }
when (6) { $a = "Heck no!"; }
when (7) { $a = "Definite yes!"; }
when (8) { $a = "Magic unavailable. Try again later."; }
when (9) { $a = "Possibly, I wouldn't count on it though."; }
when (10) { $a = "Outcome looks bad."; }
when (11) { $a = "Outcome looks good."; }
when (12) { $a = "Can't tell now. Maybe another time."; }
default { $a = "Sorry, but no."; }
}
} }
else { else {
$a = $ANSWER; $answer = $ANSWER;
$ANSWER = 0; $ANSWER = 0;
} }
privmsg($src->{svr}, $src->{chan}, "\002Answer:\002 ".$a); # Return it.
privmsg($src->{svr}, $src->{chan}, "\2Answer:\2 $answer");
return 1; return 1;
} }
# Callback for RIGBALL command. # Callback for RIGBALL command.
sub rigball sub rigball {
{
my ($src, @argv) = @_; my ($src, @argv) = @_;
# Check for necessary parameters. # Check for necessary parameters.
if (!defined $argv[0]) { if (!defined $argv[0]) {
privmsg($src->{svr}, $src->{nick}, trans("Not enough parameters")."."); privmsg($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.});
return; return;
} }
$ANSWER = join(" ", @argv); # Return result.
privmsg($src->{svr}, $src->{nick}, "Answer set to: ".$ANSWER); $ANSWER = join q{ }, @argv;
privmsg($src->{svr}, $src->{nick}, "Answer set to: $ANSWER");
return 1; return 1;
} }
# Start initialization. # Start initialization.
API::Std::mod_init('EightBall', 'Xelhua', '1.00', '3.0.0a4', __PACKAGE__); API::Std::mod_init('EightBall', 'Xelhua', '2.00', '3.0.0a10');
# vim: set ai sw=4 ts=4:
# build: perl=5.010000 # build: perl=5.010000
__END__ __END__
=head1 EightBall =head1 NAME
=head2 Description EightBall - A magic eightball module.
=over =head1 VERSION
This module adds the 8BALL and RIGBALL commands, 8BALL is a channel 2.00
command for asking the magic 8-Ball a question, RIGBALL is a private
command for setting ("rigging") the 8-Ball's next answer.
=back =head1 SYNOPSIS
=head2 Examples <JohnSmith> !8ball Will I be rich?
<Auto> Question: Will I be rich?
<Auto> Answer: Heck no!
>Auto< rigball Of course!
<JohnSmith> !8ball Will I be famous?
<Auto> Question: Will I be famous?
<Auto> Answer: Of course!
=over =head1 DESCRIPTION
<JohnSmith> !8ball Will I be rich? This module adds the 8BALL and RIGBALL commands, 8BALL is a channel command for
<Auto> Question: Will I be rich? asking the magic 8-Ball a question, RIGBALL is a private command for setting
<Auto> Answer: Heck no! ("rigging") the 8-Ball's next answer.
>Auto< rigball Of course!
<JohnSmith> !8ball Will I be famous?
<Auto> Question: Will I be famous?
<Auto> Answer: Of course!
=back =head1 AUTHOR
=head2 To Do This module was written by Elijah Perrault.
=over This module is maintained by Xelhua Development Group.
* Add Spanish, French and German translations for the help hashes. =head1 LICENSE AND COPYRIGHT
=back This module is Copyright 2010-2011 Xelhua Development Group.
=head2 Technical Released under the same licensing terms as Auto itself.
=over =cut
This module is compatible with Auto version 3.0.0a4+. # vim: set ai et sw=4 ts=4:
Ported from Auto 1.0.
=back
+109
View File
@@ -0,0 +1,109 @@
# Module: Eval. See below for documentation.
# Copyright (C) 2010-2011 Xelhua Development Group, et al.
# This program is free software; rights to this code are stated in doc/LICENSE.
package M::Eval;
use strict;
use warnings;
use English qw(-no_match_vars);
use API::Std qw(cmd_add cmd_del trans);
use API::IRC qw(privmsg notice);
# Initialization subroutine.
sub _init {
# Create the EVAL command.
cmd_add('EVAL', 2, 'cmd.eval', \%M::Eval::HELP_EVAL, \&M::Eval::cmd_eval) or return;
# Success.
return 1;
}
# Void subroutine.
sub _void {
# Delete the EVAL command.
cmd_del('EVAL') or return;
# Success.
return 1;
}
# Help hash for EVAL command. Spanish and French translations are needed.
our %HELP_EVAL = (
en => "This command allows you to eval Perl code. USE WITH CAUTION. \2Syntax:\2 EVAL <expression>",
de => "Dieser Befehl ermoeglicht du auf bewertst Perl Code. GEBRAUCH MIT VORSICHT. \2Syntax:\2 EVAL <expression>",
fr => "Cette commande vous permet d'évaluer du code Perl. UTILISER AVEC PRUDENCE. \2Syntaxe:\2 EVAL <expression>",
);
# Callback for EVAL command.
sub cmd_eval {
my ($src, @argv) = @_;
# Check for needed parameter.
if (!defined $argv[0]) {
notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.});
return;
}
# Evaluate the expression and return the result.
my $expr = join ' ', @argv;
my $result = eval($expr);
if (!defined $result) { $result = 'None' }
if ($EVAL_ERROR) {
$result = $EVAL_ERROR;
$result =~ s/(\r|\n)//gxsm;
}
# Return the result.
if (!defined $src->{chan}) {
notice($src->{svr}, $src->{nick}, "Output: $result");
}
else {
privmsg($src->{svr}, $src->{chan}, "$src->{nick}: $result");
}
return 1;
}
# Start initialization.
API::Std::mod_init('Eval', 'Xelhua', '1.01', '3.0.0a10');
# build: perl=5.010000
__END__
=head1 NAME
Eval - Allows you to evaluate Perl code from IRC
=head1 VERSION
1.01
=head1 SYNOPSIS
>blue< eval 1;
-blue- Output: 1
=head1 DESCRIPTION
This module adds the EVAL command which allows you to evaluate Perl code from
IRC, returning the output via notice.
This command requires the cmd.eval privilege.
This module is compatible with Auto v3.0.0a10+.
=head1 AUTHOR
This module was written by Elijah Perrault.
This module is maintained by Xelhua Development Group.
=head1 LICENSE AND COPYRIGHT
This module is Copyright 2010-2011 Xelhua Development Group.
This module is released under the same licensing terms as Auto itself.
=cut
# vim: set ai et sw=4 ts=4:
+9 -7
View File
@@ -12,7 +12,7 @@ use LWP::UserAgent;
sub _init sub _init
{ {
# Create the FML command. # Create the FML command.
cmd_add('FML', 0, 0, \%M::FML::HELP_FML, \&M::FML::fml) or return 0; cmd_add('FML', 0, 0, \%M::FML::HELP_FML, \&M::FML::fml) or return;
# Success. # Success.
return 1; return 1;
@@ -22,7 +22,7 @@ sub _init
sub _void sub _void
{ {
# Delete the FML command. # Delete the FML command.
cmd_del('FML') or return 0; cmd_del('FML') or return;
# Success. # Success.
return 1; return 1;
@@ -30,7 +30,8 @@ sub _void
# Help hash. # Help hash.
our %HELP_FML = ( our %HELP_FML = (
'en' => "This command will return a random FML quote. \002Syntax:\002 FML", en => "This command will return a random FML quote. \2Syntax:\2 FML",
de => "Dieser Befehl liefert eine zufaellige Zitat von FML. \2Syntax:\2 FML",
); );
# Callback for FML command. # Callback for FML command.
@@ -67,8 +68,7 @@ sub fml
} }
# Start initialization. # Start initialization.
API::Std::mod_init('FML', 'Xelhua', '1.00', '3.0.0a4', __PACKAGE__); API::Std::mod_init('FML', 'Xelhua', '1.00', '3.0.0a10');
# vim: set ai sw=4 ts=4:
# build: cpan=LWP::UserAgent perl=5.010000 # build: cpan=LWP::UserAgent perl=5.010000
__END__ __END__
@@ -99,7 +99,7 @@ have my hand back?" FML
=over =over
* Add Spanish, French and German translations for the help hash. * Add Spanish and French translations for the help hash.
=back =back
@@ -110,8 +110,10 @@ have my hand back?" FML
This module adds an extra dependency: LWP::UserAgent. You can get it from This module adds an extra dependency: LWP::UserAgent. You can get it from
the CPAN <http://www.cpan.org>. the CPAN <http://www.cpan.org>.
This module is compatible with Auto version 3.0.0a4+. This module is compatible with Auto version 3.0.0a10+.
Ported from Auto 2.0. Ported from Auto 2.0.
=back =back
# vim: set ai et sw=4 ts=4:
+10 -8
View File
@@ -12,7 +12,7 @@ use API::IRC qw(privmsg notice);
sub _init sub _init
{ {
# Not compatible with PostgreSQL. # Not compatible with PostgreSQL.
if ($Auto::ENFEAT =~ /pgsql/) { err(2, 'Unable to load Greet: PostgreSQL is not supported.', 0); return; } if ($Auto::ENFEAT =~ /pgsql/) { err(2, 'Unable to load Greet: PostgreSQL is not supported.', 0); return }
# Create the `greets` table. # Create the `greets` table.
$Auto::DB->do('CREATE TABLE IF NOT EXISTS greets (nick TEXT, greet TEXT)') or return; $Auto::DB->do('CREATE TABLE IF NOT EXISTS greets (nick TEXT, greet TEXT)') or return;
@@ -37,9 +37,10 @@ sub _void
return 1; return 1;
} }
# Help hash for GREET. Spanish, French and German translation needed. # Help hash for GREET. Spanish and French translation needed.
our %HELP_GREET = ( our %HELP_GREET = (
'en' => "This command allows management of greets. \002Syntax:\002 GREET (ADD|DEL) [nick] [greet]", en => "This command allows management of greets. \2Syntax:\2 GREET (ADD|DEL) [nick] [greet]",
de => "Dieser Befehl ermoeglicht die Verwaltung von Gruesse. \2Syntax:\2 GREET (ADD|DEL) [nick] [greet]",
); );
# Callback for GREET. # Callback for GREET.
sub cmd_greet sub cmd_greet
@@ -100,7 +101,7 @@ sub cmd_greet
$Auto::DB->do('DELETE FROM greets WHERE nick = "'.$nick.'"') or notice($src->{svr}, $src->{nick}, trans('An error occurred').q{.}) and return; $Auto::DB->do('DELETE FROM greets WHERE nick = "'.$nick.'"') or notice($src->{svr}, $src->{nick}, trans('An error occurred').q{.}) and return;
notice($src->{svr}, $src->{nick}, "Greet for \002$nick\002 successfully deleted."); notice($src->{svr}, $src->{nick}, "Greet for \002$nick\002 successfully deleted.");
} }
default { notice($src->{svr}, $src->{nick}, "Unknown action \002$argv[0]\002. \002Syntax:\002 GREET (ADD|DEL)"); return; } default { notice($src->{svr}, $src->{nick}, "Unknown action \002$argv[0]\002. \002Syntax:\002 GREET (ADD|DEL)"); return }
} }
return 1; return 1;
@@ -125,8 +126,7 @@ sub hook_rcjoin
} }
# Start initialization. # Start initialization.
API::Std::mod_init('Greet', 'Xelhua', '1.00', '3.0.0a4', __PACKAGE__); API::Std::mod_init('Greet', 'Xelhua', '1.00', '3.0.0a10');
# vim: set ai sw=4 ts=4:
# build: perl=5.010000 # build: perl=5.010000
__END__ __END__
@@ -146,7 +146,7 @@ user that has a greet in the database joins a channel the bot is in.
=over =over
* Add Spanish, French and German translations for the help hash. * Add Spanish and French translations for the help hash.
=back =back
@@ -154,6 +154,8 @@ user that has a greet in the database joins a channel the bot is in.
=over =over
This module is compatible with Auto version 3.0.0a4+. This module is compatible with Auto version 3.0.0a10+.
=back =back
# vim: set ai et sw=4 ts=4:
+38 -9
View File
@@ -11,7 +11,7 @@ use API::IRC qw(privmsg);
sub _init sub _init
{ {
# Add a hook for when we join a channel. # Add a hook for when we join a channel.
hook_add("on_ucjoin", "HelloChan", \&M::HelloChan::hello) or return 0; hook_add('on_ucjoin', 'HelloChan', \&M::HelloChan::hello) or return;
return 1; return 1;
} }
@@ -19,7 +19,7 @@ sub _init
sub _void sub _void
{ {
# Delete the hook. # Delete the hook.
hook_del("on_ucjoin", "HelloChan") or return 0; hook_del('on_ucjoin', 'HelloChan') or return;
return 1; return 1;
} }
@@ -29,23 +29,52 @@ sub hello
my (($svr, $chan)) = @_; my (($svr, $chan)) = @_;
# Send a PRIVMSG. # Send a PRIVMSG.
privmsg($svr, $chan, "Hello channel! I am a bot!"); privmsg($svr, $chan, 'Hello channel! I am a bot!');
return 1; return 1;
} }
# Start initialization. # Start initialization.
API::Std::mod_init('HelloChan', 'Xelhua', '1.00', '3.0.0a4', __PACKAGE__); API::Std::mod_init('HelloChan', 'Xelhua', '1.00', '3.0.0a10');
# vim: set ai sw=4 ts=4:
# build: perl=5.010000 # build: perl=5.010000
__END__ __END__
=head1 HelloChan =head1 NAME
=over HelloChan - An example module. Also, cows go moo.
This is an example module. Also, cows go moo. =head1 VERSION
=back 1.00
=head1 SYNOPSIS
* Auto has joined #moocows
<Auto> Hello channel! I am a bot!
=head1 DESCRIPTION
This module sends "Hello channel! I am a bot!" whenever it
joins a channel.
=head1 INSTALL
No additonal steps need to be taking to use this module.
=head1 AUTHOR
This module was written by Elijah Perrault.
This module is maintained by Xelhua Development Group.
=head1 LICENSE AND COPYRIGHT
This module is Copyright 2010-2011 Xelhua Development Group.
Released under the same licensing terms as Auto itself.
=cut
# vim: set ai et sw=4 ts=4:
+8 -6
View File
@@ -12,7 +12,7 @@ use LWP::UserAgent;
sub _init sub _init
{ {
# Create the ISITUP command. # Create the ISITUP command.
cmd_add('ISITUP', 0, 0, \%M::IsItUp::HELP_ISITUP, \&M::IsItUp::check) or return 0; cmd_add('ISITUP', 0, 0, \%M::IsItUp::HELP_ISITUP, \&M::IsItUp::check) or return;
# Success. # Success.
return 1; return 1;
@@ -22,7 +22,7 @@ sub _init
sub _void sub _void
{ {
# Delete the ISITUP command. # Delete the ISITUP command.
cmd_del('ISITUP') or return 0; cmd_del('ISITUP') or return;
# Success. # Success.
return 1; return 1;
@@ -31,6 +31,7 @@ sub _void
# Help hashes. # Help hashes.
our %HELP_ISITUP = ( our %HELP_ISITUP = (
'en' => "This command will check if a website appears up or down to the bot. \002Syntax:\002 ISITUP <url>", 'en' => "This command will check if a website appears up or down to the bot. \002Syntax:\002 ISITUP <url>",
'fr' => "Cette commande va vérifier si un site Web semble être vers le haut ou vers le bas pour le bot. \002Syntaxe:\002 ISITUP <url>",
); );
# Callback for ISITUP command. # Callback for ISITUP command.
@@ -45,7 +46,7 @@ sub check
# Do we have enough parameters? # Do we have enough parameters?
if (!defined $argv[0]) { if (!defined $argv[0]) {
notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.}); notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.});
return 0; return;
} }
my $curl = $argv[0]; my $curl = $argv[0];
# Does the URL start with http(s)? # Does the URL start with http(s)?
@@ -69,8 +70,7 @@ sub check
} }
# Start initialization. # Start initialization.
API::Std::mod_init('IsItUp', 'Xelhua', '1.00', '3.0.0a4', __PACKAGE__); API::Std::mod_init('IsItUp', 'Xelhua', '1.00', '3.0.0a10');
# vim: set ai sw=4 ts=4:
# build: cpan=LWP::UserAgent perl=5.010000 # build: cpan=LWP::UserAgent perl=5.010000
__END__ __END__
@@ -110,6 +110,8 @@ appears up or down to Auto.
This module requires LWP::UserAgent. You can get it from This module requires LWP::UserAgent. You can get it from
the CPAN <http://www.cpan.org>. the CPAN <http://www.cpan.org>.
This module is compatible with Auto version 3.0.0a4+. This module is compatible with Auto version 3.0.0a10+.
=back =back
# vim: set ai et sw=4 ts=4:
+101
View File
@@ -0,0 +1,101 @@
# Module: LOLCAT. See below for documentation.
# Copyright (C) 2010-2011 Xelhua Development Group, et al.
# This program is free software; rights to this code are stated in doc/LICENSE.
package M::LOLCAT;
use strict;
use warnings;
use API::Std qw(cmd_add cmd_del trans);
use API::IRC qw(privmsg notice);
use Acme::LOLCAT;
# Initialization subroutine.
sub _init {
# Create LOLCAT command.
cmd_add('LOLCAT', 0, 0, \%M::LOLCAT::HELP_LOLCAT, \&M::LOLCAT::cmd_lolcat) or return;
# Success.
return 1;
}
# Void subroutine.
sub _void {
# Delete LOLCAT command.
cmd_del('LOLCAT') or return;
# Success.
return 1;
}
# Help for LOLCAT.
our %HELP_LOLCAT = (
en => "This command will translate English to LOLCAT speak. \2Syntax:\2 LOLCAT <text>",
fr => "Cette commande va traduire l'anglais vers LOLCAT parler. \2Syntaxe:\2 LOLCAT <texte",
);
# Callback for LOLCAT command.
sub cmd_lolcat {
my ($src, @argv) = @_;
# At least one parameter is required.
if (!defined $argv[0]) {
notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.});
return;
}
# Return LOLCAT translation.
privmsg($src->{svr}, $src->{chan}, 'Result: '.translate(join q{ }, @argv));
return 1;
}
# Start initialization.
API::Std::mod_init('LOLCAT', 'Xelhua', '1.00', '3.0.0a10');
# build: perl=5.010000 cpan=Acme::LOLCAT
__END__
=head1 NAME
LOLCAT - Translates English into LOLCAT.
=head1 VERSION
1.00
=head1 SYNOPSIS
<starcoder> !lolcat You too can speak like a lolcat!
<Auto> Result: YU T CAN SPEKK LIEK LOLCAT! KTHXBYE!
=head1 DESCRIPTION
This will create the LOLCAT command which allows you to translate English text
into LOLCAT speak.
See also: http://en.wikipedia.org/wiki/Lolcat
=head1 DEPENDENCIES
This module is dependent on the following modules from CPAN:
=over
=item L<Acme::LOLCAT>
This is what the module uses to translate English into LOLCAT.
=back
=head1 AUTHOR
This module was written by Elijah Perrault.
This module is maintained by Xelhua Development Group.
=head1 LICENSE AND COPYRIGHT
This module is Copyright 2010-2011 Xelhua Development Group.
Released under the same licensing terms as Auto itself.
=cut
# vim: set ai et ts=4 sw=4:
+128
View File
@@ -0,0 +1,128 @@
# Module: LinkTitle. See below for documentation.
# Copyright (C) 2010-2011 Xelhua Development Group, et al.
# This program is free software; rights to this code are stated in doc/LICENSE.
package M::LinkTitle;
use strict;
use warnings;
use LWP::UserAgent;
use HTML::Entities;
use API::Std qw(hook_add hook_del);
use API::IRC qw(privmsg);
# Initialization subroutine.
sub _init
{
# Create the on_cprivmsg hook.
hook_add('on_cprivmsg', 'privmsg.html.returntitle', \&M::LinkTitle::gettitle) or return;
# Success.
return 1;
}
# Void subroutine.
sub _void
{
# Delete the hook we created.
hook_del('on_cprivmsg', 'privmsg.html.returntitle') or return;
# Success.
return 1;
}
# Hook callback.
sub gettitle
{
my ($src, $chan, @msg) = @_;
# Check if the message contains a URL.
foreach my $smw (@msg) {
if ($smw =~ m{(http|https)://}xsm) {
# We've got a match, connect to the server.
my $srv = $1;
# Create an instance of LWP::UserAgent.
my $ua = LWP::UserAgent->new();
$ua->agent('Auto IRC Bot');
$ua->timeout(3);
# Get data.
my $res = $ua->get($smw);
# Check if we're successful.
if ($res->is_success) {
# We were, decode the data.
my $data = $res->decoded_content;
# Strip newlines.
$data =~ s/(\n|\r)//gxsm;
# Check for <title>
if ($data =~ m{<title>(.*)</title>}ixsm) {
# Found. Decode it.
my $title = decode_entities($1);
# Return to channel.
privmsg($src->{svr}, $chan, "\2Title:\2 $title");
}
}
}
}
return 1;
}
# Start initialization.
API::Std::mod_init('LinkTitle', 'Xelhua', '1.01', '3.0.0a10');
# build: cpan=LWP::UserAgent,HTML::Entities perl=5.010000
__END__
=head1 NAME
LinkTitle - A module for returning the page title of links.
=head1 VERSION
1.01
=head1 SYNOPSIS
<starcoder> http://xelhua.org/auto.php
<blue> Title: Xelhua / Projects / Auto
=head1 DESCRIPTION
This module will make Auto parse all links sent to a channel. When a link is
detected, Auto will connect to it and get the page title by scanning for the
<title> tag and returning its contents to the channel.
=head1 DEPENDENCIES
This module is dependent on two modules from the CPAN.
=over
=item L<LWP::UserAgent|LWP::UserAgent>
This module is used for connecting to the target web server via HTTP(S).
=item L<HTML::Entities|HTML::Entities>
This module is used for decoding HTML entities in the response we receive from
the server.
=back
=head1 AUTHOR
This module was written by Elijah Perrault.
This module is maintained by Xelhua Development Group.
=head1 LICENSE AND COPYRIGHT
This module is Copyright 2010-2011 Xelhua Development Group. All rights
reserved.
This module is released under the same licensing terms as Auto itself.
=cut
# vim: set ai et sw=4 ts=4:
+128
View File
@@ -0,0 +1,128 @@
# Module: Oper.
# Copyright (C) 2010-2011 Xelhua Development Group, et al.
# This program is free software; rights to this code are stated in doc/LICENSE.
package M::Oper;
use strict;
use warnings;
use API::Std qw(hook_add hook_del rchook_add rchook_del conf_get);
use API::Log qw(alog);
# Initialization subroutine.
sub _init
{
# Add a hook for when we join a channel.
hook_add('on_connect', 'Oper.onconnect', \&M::Oper::on_connect) or return;
# Add a hook for when we get numeric 491 (ERR_NOOPERHOST)
rchook_add('491', 'Oper.on491', \&M::Oper::on_num491) or return;
return 1;
}
# Void subroutine.
sub _void
{
# Delete the hooks.
hook_del('on_connect', 'Oper.onconnect') or return;
rchook_del('381', 'Oper.on381') or return;
rchook_del('313', 'Oper.on313') or return;
rchook_del('491', 'Oper.on491') or return;
return 1;
}
# On connect subroutine.
sub on_connect
{
my ($svr) = @_;
# Get the configuration values.
my $u = (conf_get("server:$svr:oper_username"))[0][0] if conf_get("server:$svr:oper_username");
my $p = (conf_get("server:$svr:oper_password"))[0][0] if conf_get("server:$svr:oper_password");
# They don't exist - don't continue.
return if !$u or !$p;
# Send the OPER command.
oper($svr, $u, $p);
return 1;
}
# On 491 subroutine
sub on_num491 {
my ($svr, @ex) = @_;
my $reason = join ' ', @ex[3 .. $#ex];
$reason =~ s/://xsm;
alog("FAILED OPER on ".$svr.": ".$reason);
return 1;
}
# A subroutine to check if we are opered on a server
sub is_opered {
my ($svr) = @_;
# Auto is not opered.
return if $State::IRC::botinfo{$svr}{modes} !~ m/o/xsm;
# Auto is opered.
return 1 if $State::IRC::botinfo{$svr}{modes} =~ m/o/xsm;
return;
}
# Start of the API
# Sends the OPER command to the specified server.
sub oper {
my ($svr, $user, $pass) = @_;
Auto::socksnd($svr, "OPER $user $pass");
return 1;
}
# Deopers Auto on the specified server.
sub deoper {
my ($svr) = @_;
Auto::socksnd($svr, "MODE $State::IRC::botinfo{$svr}{nick} -o");
return 1;
}
# End of the API
# Start initialization.
API::Std::mod_init('Oper', 'Xelhua', '1.01', '3.0.0a10');
# build: perl=5.010000
__END__
=head1 NAME
Oper - Auto oper-on-connect module.
=head1 VERSION
1.01
=head1 SYNOPSIS
No commands are currently associated with Oper.
=head1 DESCRIPTION
This module adds the ability for Auto to oper on networks he is
configured to do so on.
=head1 INSTALL
Before using Oper, add the following to the server block in your
configuration file, only for servers you wish for Auto to oper on
though:
oper_username <username>;
oper_password <password>;
=head1 AUTHOR
This module was written by Matthew Barksdale.
This module is maintained by Xelhua Development Group.
=head1 LICENSE AND COPYRIGHT
This module is Copyright 2010-2011 Xelhua Development Group.
Released under the same licensing terms as Auto itself.
=cut
# vim: set ai et sw=4 ts=4:
+136
View File
@@ -0,0 +1,136 @@
# Module: Ping. See below for documentation.
# Copyright (C) 2010-2011 Xelhua Development Group, et al.
# This program is free software; rights to this code are stated in doc/LICENSE.
package M::Ping;
use strict;
use warnings;
use API::Std qw(cmd_add cmd_del hook_add hook_del rchook_add rchook_del);
use API::IRC qw(privmsg notice who);
my (@PING, $STATE);
my $LAST = 0;
# Initialization subroutine.
sub _init {
# Create the PING command.
cmd_add('PING', 0, 'cmd.ping', \%M::Ping::HELP_PING, \&M::Ping::cmd_ping) or return;
# Create the on_whoreply hook.
hook_add('on_whoreply', 'ping.who', \&M::Ping::on_whoreply) or return;
# Hook onto numeric 315.
rchook_add('315', 'ping.eow', \&M::Ping::ping) or return;
# Success.
return 1;
}
# Void subroutine.
sub _void {
# Delete the PING command.
cmd_del('PING') or return;
# Delete the on_whoreply hook.
hook_del('on_whoreply', 'ping.who') or return;
# Delete 315 hook.
rchook_del('315', 'ping.eow') or return;
# Success.
return 1;
}
# Help for PING.
our %HELP_PING = (
en => "This command will ping all non-/away users in the channel. \2Syntax:\2 PING",
);
# Callback for PING command.
sub cmd_ping {
my ($src, @argv) = @_;
# Check ratelimit (once every five minutes).
if ((time - $LAST) < 300) {
notice($src->{svr}, $src->{nick}, 'This command is ratelimited. Please wait a while before using it again.');
return;
}
# Set last used time to current time.
$LAST = time;
# Set state.
$STATE = $src->{svr}.'::'.$src->{chan};
# Ship off a WHO.
who($src->{svr}, $src->{chan});
return 1;
}
# Callback for WHO reply.
sub on_whoreply {
my ($svr, $nick, $target, undef, undef, undef, $status, undef, undef) = @_;
# If it's us, just return.
if ($nick eq $State::IRC::botinfo{$svr}{nick}) { return 1 }
# Check if we're doing a ping right now.
if ($STATE) {
# Check if this is the target channel.
if ($STATE eq $svr.'::'.$target) {
# If their status is not away, push to ping array.
if ($status !~ m/G/xsm) {
push @PING, $nick;
}
}
}
return 1;
}
# Ping!
sub ping {
if ($STATE) {
my ($svr, $chan) = split '::', $STATE, 2;
privmsg($svr, $chan, 'PING! '.join(' ', @PING));
@PING = ();
$STATE = 0;
}
return 1;
}
# Start initialization.
API::Std::mod_init('Ping', 'Xelhua', '1.01', '3.0.0a11');
# build: perl=5.010000
__END__
=head1 NAME
Ping - A module for pinging a channel.
=head1 VERSION
1.01
=head1 SYNOPSIS
<Hermione> .ping
<howlbot> PING! `A` tdubellz Hermione Oakfeather LightToagac shadowm_goat kitten starcoder2 Suiseiseki metabill theknife Trashlord Cam HardDisk_WP nerdshark2 MJ94 JonathanD Julius2 CensoredBiscuit LordVoldemort e36freak alyx mth starcoder
=head1 DESCRIPTION
This merely creates the PING command, which will highlight everyone in the
channel, excluding the bot itself and those who are /away.
=head1 AUTHOR
This module was written by Elijah Perrault.
This module is maintained by Xelhua Development Group.
=head1 LICENSE AND COPYRIGHT
This module is Copyright 2010-2011 Xelhua Development Group. All rights
reserved.
This module is released under the same licensing terms as Auto itself.
=cut
# vim: set ai et ts=4 sw=4:
+119 -30
View File
@@ -5,8 +5,9 @@ package M::QDB;
use strict; use strict;
use warnings; use warnings;
use feature qw(switch); use feature qw(switch);
use API::Std qw(cmd_add cmd_del trans has_priv match_user); use API::Std qw(cmd_add cmd_del trans has_priv conf_get match_user);
use API::IRC qw(privmsg notice); use API::IRC qw(privmsg notice);
our @BUFFER;
sub _init sub _init
{ {
@@ -14,7 +15,7 @@ sub _init
cmd_add('QDB', 0, 0, \%M::QDB::HELP_QDB, \&M::QDB::cmd_qdb) or return; cmd_add('QDB', 0, 0, \%M::QDB::HELP_QDB, \&M::QDB::cmd_qdb) or return;
# Check the database format. Fail to load if it's PostgreSQL. # Check the database format. Fail to load if it's PostgreSQL.
if ($Auto::ENFEAT =~ /pgsql/) { err(2, 'Unable to load QDB: PostgreSQL is not supported.', 0); return; } if ($Auto::ENFEAT =~ /pgsql/) { err(2, 'Unable to load QDB: PostgreSQL is not supported.', 0); return }
# Check for database table. # Check for database table.
$Auto::DB->do('CREATE TABLE IF NOT EXISTS qdb (quoteid INTEGER PRIMARY KEY, creator TEXT, time INTEGER, quote TEXT)') or return; $Auto::DB->do('CREATE TABLE IF NOT EXISTS qdb (quoteid INTEGER PRIMARY KEY, creator TEXT, time INTEGER, quote TEXT)') or return;
@@ -34,7 +35,7 @@ sub _void
# Help hash for QDB. Spanish, French and German translations needed. # Help hash for QDB. Spanish, French and German translations needed.
our %HELP_QDB = ( our %HELP_QDB = (
'en' => "This command allows you to add, read, and delete quotes. \002Syntax:\002 QDB (ADD|VIEW|COUNT|RAND|DEL) [quote]", 'en' => "This command allows you to add, read, and delete quotes. \002Syntax:\002 QDB (ADD|VIEW|COUNT|RAND|SEARCH|MORE|DEL) [quote|expression]",
); );
sub cmd_qdb sub cmd_qdb
{ {
@@ -46,7 +47,7 @@ sub cmd_qdb
return; return;
} }
# ADD|VIEW|COUNT|RAND|DEL. # ADD|VIEW|COUNT|RAND|SEARCH|MORE|DEL.
given (uc $argv[0]) { given (uc $argv[0]) {
when ('ADD') { when ('ADD') {
# QDB ADD. # QDB ADD.
@@ -55,13 +56,10 @@ sub cmd_qdb
return; return;
} }
# Get rid of the ADD part.
shift @argv;
# Insert into database. # Insert into database.
my $dbq = $Auto::DB->prepare('INSERT INTO qdb (creator, time, quote) VALUES (?, ?, ?)') or my $dbq = $Auto::DB->prepare('INSERT INTO qdb (creator, time, quote) VALUES (?, ?, ?)') or
notice($src->{svr}, $src->{nick}, trans('An error occurred').q{.}) and return; notice($src->{svr}, $src->{nick}, trans('An error occurred').q{.}) and return;
$dbq->execute($src->{nick}, time, join(q{ }, @argv)) or $dbq->execute($src->{nick}, time, join(q{ }, @argv[1..$#argv])) or
notice($src->{svr}, $src->{nick}, trans('An error occurred').q{.}) and return; notice($src->{svr}, $src->{nick}, trans('An error occurred').q{.}) and return;
# Get ID. # Get ID.
@@ -83,9 +81,12 @@ sub cmd_qdb
$dbq->execute($argv[1]) or notice($src->{svr}, $src->{nick}, trans('An error occurred').'. Quote might not exist.') and return; $dbq->execute($argv[1]) or notice($src->{svr}, $src->{nick}, trans('An error occurred').'. Quote might not exist.') and return;
my @data = $dbq->fetchrow_array; my @data = $dbq->fetchrow_array;
# Check for an unusual issue.
if (!defined $data[1]) { notice($src->{svr}, $src->{nick}, trans('An error occurred').'. Quote might not exist.'); return }
# Send it back. # Send it back.
privmsg($src->{svr}, $src->{chan}, "\002Submitted by\002 $data[1] \002on\002 ".POSIX::strftime('%F', localtime($data[2]))." \002at\002 ".POSIX::strftime('%I:%M %p', localtime($data[2]))); privmsg($src->{svr}, $src->{chan}, "\002Submitted by\002 $data[1] \002on\002 ".POSIX::strftime('%F', localtime($data[2]))." \002at\002 ".POSIX::strftime('%I:%M %p', localtime($data[2])));
privmsg($src->{svr}, $src->{chan}, $data[3]); privmsg($src->{svr}, $src->{chan}, '> '.$data[3]);
} }
when ('COUNT') { when ('COUNT') {
# Get count. # Get count.
@@ -102,7 +103,7 @@ sub cmd_qdb
# Random number. # Random number.
my $rand = int(rand($count)); my $rand = int(rand($count));
if ($rand == 0) { $rand = $count; } if ($rand == 0) { $rand = $count }
# Get quote. # Get quote.
my $dbq = $Auto::DB->prepare('SELECT * FROM qdb WHERE quoteid = ?') or my $dbq = $Auto::DB->prepare('SELECT * FROM qdb WHERE quoteid = ?') or
@@ -112,7 +113,79 @@ sub cmd_qdb
# Send it back. # Send it back.
privmsg($src->{svr}, $src->{chan}, "\002ID:\002 $data[0] - \002Submitted by\002 $data[1] \002on\002 ".POSIX::strftime('%F', localtime($data[2]))." \002at\002 ".POSIX::strftime('%I:%M %p', localtime($data[2]))); privmsg($src->{svr}, $src->{chan}, "\002ID:\002 $data[0] - \002Submitted by\002 $data[1] \002on\002 ".POSIX::strftime('%F', localtime($data[2]))." \002at\002 ".POSIX::strftime('%I:%M %p', localtime($data[2])));
privmsg($src->{svr}, $src->{chan}, $data[3]); privmsg($src->{svr}, $src->{chan}, '> '.$data[3]);
}
when ('SEARCH') {
# QDB SEARCH.
# Get all quotes.
my $dbq = $Auto::DB->prepare('SELECT * FROM qdb') or return;
$dbq->execute or return;
my $quotes = $dbq->fetchall_hashref('quoteid') or return;
# Set expression.
my $expr = my $rexpr = join ' ', @argv[1 .. $#argv];
$rexpr =~ s{\(}{\\\(}g;
$rexpr =~ s{\)}{\\\)}g;
$rexpr =~ s{\?}{\\\?}g;
$rexpr =~ s{\*}{\\\*}g;
$rexpr =~ s{\[}{\\\[}g;
$rexpr =~ s{\]}{\\\]}g;
$rexpr =~ s{\.}{\\\.}g;
$rexpr =~ s{\$}{\\\$}g;
$rexpr =~ s{\^}{\\\^}g;
# Clear the buffer.
@BUFFER = ();
# Iterate through all quotes.
foreach my $qkt (keys %$quotes) {
# Check if we have a match.
if ($quotes->{$qkt}->{quote} =~ m/$rexpr/ixsm) {
# Match. Add to buffer.
push @BUFFER, "\2ID:\2 $qkt - ".$quotes->{$qkt}->{quote};
}
}
# Check if we had any matches.
if (!defined $BUFFER[0]) {
privmsg($src->{svr}, $src->{chan}, "No results for \2$expr\2.");
return;
}
# Return four quotes.
privmsg($src->{svr}, $src->{chan}, "\2".scalar @BUFFER."\2 results for \2$expr\2:");
my $i = 0;
my $si = 3;
if (conf_get('qdb_search_resnum')) { $si = (conf_get('qdb_search_resnum'))[0][0] - 1 }
while ($i <= $si) {
if (!defined $BUFFER[0]) {
last;
}
privmsg($src->{svr}, $src->{chan}, shift @BUFFER);
$i++;
}
}
when ('MORE') {
# Check if there's any quotes in the buffer.
if (!defined $BUFFER[0]) {
notice($src->{svr}, $src->{nick}, 'No quotes in buffer.');
return;
}
# Return four quotes.
my $i = 0;
my $si = 3;
if (conf_get('qdb_search_resnum')) { $si = (conf_get('qdb_search_resnum'))[0][0] - 1 }
while ($i <= $si) {
if (!defined $BUFFER[0]) {
last;
}
privmsg($src->{svr}, $src->{chan}, shift @BUFFER);
$i++;
}
} }
when ('DEL') { when ('DEL') {
# Check for the cmd.qdbdel privilege. # Check for the cmd.qdbdel privilege.
@@ -131,44 +204,60 @@ sub cmd_qdb
notice($src->{svr}, $src->{nick}, (($dbq) ? 'Done.' : trans('An error occurred').q{.})); notice($src->{svr}, $src->{nick}, (($dbq) ? 'Done.' : trans('An error occurred').q{.}));
} }
default { notice($src->{svr}, $src->{nick}, "Unknown action \002".uc($argv[0])."\002. \002Syntax:\002 QDB (ADD|VIEW|COUNT|RAND|DEL) [quote]"); return; } default { notice($src->{svr}, $src->{nick}, "Unknown action \002".uc($argv[0])."\002. \002Syntax:\002 QDB (ADD|VIEW|COUNT|RAND|DEL) [quote]"); return }
} }
return 1; return 1;
} }
API::Std::mod_init('QDB', 'Xelhua', '1.00', '3.0.0a4', __PACKAGE__); API::Std::mod_init('QDB', 'Xelhua', '1.04', '3.0.0a10');
# vim: set ai sw=4 ts=4:
# build: perl=5.010000 # build: perl=5.010000
__END__ __END__
=head1 QDB =head1 NAME
=head2 Description QDB - Quote database module.
=over =head1 VERSION
This module adds the QDB (ADD|VIEW|COUNT|RAND|DEL) command, for adding, 1.04
viewing, listing number of, viewing a random, deleting a quote from the Auto
database.
=back =head1 SYNOPSIS
=head2 Examples <JohnSmith> !qdb add <JohnDoe> moocows
<Auto> Quote successfully submitted. ID: 732
=over =head1 DESCRIPTION
<JohnSmith> !qdb add <JohnDoe> moocows This module adds the QDB (ADD|VIEW|COUNT|RAND|SEARCH|MORE|DEL) command, for
<Auto> Quote successfully submitted. ID: 732 adding, viewing, listing number of, viewing a random, deleting a quote from the
Auto database.
=back =head1 INSTALL
=head2 Technical Before using QDB, we'd recommend adding the following to your configuration
file:
=over qdb_search_resnum <number>;
This module is compatible with Auto v3.0.0a4+. Where <number> is the amount of results returned per SEARCH/MORE load.
=back This is not required, 4 will be used if it is not specified.
=head1 AUTHOR
This module was written by Elijah Perrault.
This module is maintained by Xelhua Development Group.
=head1 LICENSE AND COPYRIGHT
This module is Copyright 2010-2011 Xelhua Development Group.
Released under the same licensing terms as Auto itself.
=cut
# vim: set ai et sw=4 ts=4:
+31 -49
View File
@@ -14,18 +14,20 @@ use API::IRC qw(privmsg);
sub _init sub _init
{ {
# Check if this Auto was built with SASL support. # Check if this Auto was built with SASL support.
err(2, "Auto was not built with SASL support. Aborting SASLAuth.", 0) and return 0 if $Auto::ENFEAT !~ /sasl/; if ($Auto::ENFEAT !~ m/sasl/xsm) { err(2, 'Auto was not built with SASL support. Aborting SASLAuth.', 0) and return }
# Add a hook for before we connect. # Add sasl to supported CAP for servers configured with SASL.
hook_add('on_preconnect', 'CAP', sub { my ($srv) = @_; Auto::socksnd($srv, 'CAP LS'); } my %servers = conf_get('server');
) or return 0; foreach my $svr (keys %servers) {
# Hook for parsing CAP. if (conf_get("server:$svr:sasl_username") and conf_get("server:$svr:sasl_password") and conf_get("server:$svr:sasl_timeout")) { $Proto::IRC::cap{$svr} .= ' sasl' }
rchook_add('CAP', \&M::SASLAuth::handle_cap) or return 0; }
# Hook for when CAP ACK sasl is received.
hook_add('on_capack', 'sasl.cap', \&M::SASLAuth::handle_capack) or return;
# Hook for parsing 903. # Hook for parsing 903.
rchook_add('903', \&M::SASLAuth::handle_903) or return 0; rchook_add('903', 'sasl.903', \&M::SASLAuth::handle_903) or return;
# Hook for parsing 904. # Hook for parsing 904.
rchook_add('904', \&M::SASLAuth::handle_904) or return 0; rchook_add('904', 'sasl.904', \&M::SASLAuth::handle_904) or return;
# Hook for parsing 906. # Hook for parsing 906.
rchook_add('906', \&M::SASLAuth::handle_906) or return 0; rchook_add('906', 'sasl.906', \&M::SASLAuth::handle_906) or return;
return 1; return 1;
} }
@@ -33,42 +35,21 @@ sub _init
sub _void sub _void
{ {
# Delete the hooks. # Delete the hooks.
hook_del("on_preconnect", "CAP") or return 0; hook_del('on_capack') or return;
rchook_del('CAP'); rchook_del('903', 'sasl.903') or return;
rchook_del('903'); rchook_del('904', 'sasl.904') or return;
rchook_del('904'); rchook_del('906', 'sasl.906') or return;
rchook_del('906');
return 1; return 1;
} }
sub handle_cap { sub handle_capack {
my ($srv, @parv) = @_; my (($svr, $sacap)) = @_;
my $line = join(' ',@parv);
my ($tosend);
given ($line) { if ($sacap eq 'sasl') {
when (/ LS /) { Auto::socksnd($svr, 'AUTHENTICATE PLAIN');
$tosend .= 'multi-prefix ' if $line =~ /multi-prefix/i; timer_add('auth_timeout_'.$svr, 1, (conf_get("server:$svr:sasl_timeout"))[0][0], sub { Auto::socksnd($svr, 'CAP END') });
$tosend .= 'sasl ' if $line =~ /sasl/ and conf_get("server:$srv:sasl_username");
awarn(2, "SASL is unavailable on this server.") if $tosend !~ /sasl/;
if ($tosend eq '') { Auto::socksnd($srv, 'CAP END') }
else { Auto::socksnd($srv, "CAP REQ :$tosend"); }
}
when (/ ACK /) {
if ( $line =~ /sasl/) {
Auto::socksnd($srv, 'AUTHENTICATE PLAIN');
timer_add('auth_timeout', 1, (conf_get("server:$srv:sasl_timeout"))[0][0], sub { Auto::socksnd($srv, 'CAP END'); });
}
else {
Auto::socksnd($srv, 'CAP END');
awarn(2, "SASL authentication failed at ACK");
}
}
when (/ NAK /) {
Auto::socksnd($srv, 'CAP END');
awarn(2, "SASL authentication failed. Server refused ".$tosend);
}
} }
return 1; return 1;
} }
@@ -105,8 +86,8 @@ sub handle_authenticate
sub handle_903 sub handle_903
{ {
my ($srv, undef) = @_; my ($srv, undef) = @_;
Auto::socksnd($srv, 'CAP END'); timer_add('cap_end_'.$srv, 1, 2, sub { Auto::socksnd($srv, 'CAP END') });
timer_del('auth_timeout'); timer_del('auth_timeout_'.$srv);
} }
# Parse: Numeric:904 # Parse: Numeric:904
@@ -114,8 +95,8 @@ sub handle_903
sub handle_904 sub handle_904
{ {
my ($srv, undef) = @_; my ($srv, undef) = @_;
Auto::socksnd($srv, 'CAP END'); timer_add('cap_end_'.$srv, 1, 2, sub { Auto::socksnd($srv, 'CAP END') });
timer_del('auth_timeout'); timer_del('auth_timeout_'.$srv);
awarn(2, "SASL authentication failed!"); awarn(2, "SASL authentication failed!");
} }
@@ -124,14 +105,13 @@ sub handle_904
sub handle_906 sub handle_906
{ {
my ($svr, undef) = @_; my ($svr, undef) = @_;
Auto::socksnd($svr, 'CAP END'); timer_add('cap_end_'.$svr, 1, 2, sub { Auto::socksnd($svr, 'CAP END') });
timer_del('auth_timeout'); timer_del('auth_timeout_'.$svr);
awarn(2, "SASL authentication aborted!"); awarn(2, "SASL authentication aborted!");
} }
# Start initialization. # Start initialization.
API::Std::mod_init('SASLAuth', 'Xelhua', '1.00', '3.0.0a4', __PACKAGE__); API::Std::mod_init('SASLAuth', 'Xelhua', '1.00', '3.0.0a10');
# vim: set ai sw=4 ts=4:
# build: perl=5.010000 # build: perl=5.010000
__END__ __END__
@@ -188,6 +168,8 @@ block(s) you wish to use SASL with:
This adds an extra dependency: You must build Auto with the This adds an extra dependency: You must build Auto with the
--enable-sasl option. --enable-sasl option.
This module is compatible with Auto v3.0.0a4+. This module is compatible with Auto v3.0.0a10+.
=back =back
# vim: set ai et sw=4 ts=4:
+1602
View File
File diff suppressed because it is too large. Load diff
+12 -10
View File
@@ -13,7 +13,7 @@ use XML::Simple;
sub _init sub _init
{ {
# Create the Weather command. # Create the Weather command.
cmd_add("WEATHER", 0, 0, \%M::Weather::HELP_WEATHER, \&M::Weather::weather) or return 0; cmd_add('WEATHER', 0, 0, \%M::Weather::HELP_WEATHER, \&M::Weather::weather) or return;
# Success. # Success.
return 1; return 1;
@@ -23,7 +23,7 @@ sub _init
sub _void sub _void
{ {
# Delete the Weather command. # Delete the Weather command.
cmd_del("WEATHER") or return 0; cmd_del('WEATHER') or return;
# Success. # Success.
return 1; return 1;
@@ -32,6 +32,7 @@ sub _void
# Help hashes. # Help hashes.
our %HELP_WEATHER = ( our %HELP_WEATHER = (
'en' => "This command will retrieve the weather via Wunderground for the specified location. \002Syntax:\002 WEATHER <location>", 'en' => "This command will retrieve the weather via Wunderground for the specified location. \002Syntax:\002 WEATHER <location>",
'fr' => "Cette commande permet de récupérer la météo via Wunderground pour l'emplacement spécifié. \002Syntaxe:\002 WEATHER <emplacement>",
); );
# Callback for Weather command. # Callback for Weather command.
@@ -45,8 +46,8 @@ sub weather
$ua->timeout(2); $ua->timeout(2);
# Put together the call to the Wunderground API. # Put together the call to the Wunderground API.
if (!defined $args[0]) { if (!defined $args[0]) {
notice($src->{svr}, $src->{nick}, trans("Not enough parameters")."."); notice($src->{svr}, $src->{nick}, trans('Not enough parameters').".");
return 0; return;
} }
my $loc = join(' ', @args); my $loc = join(' ', @args);
$loc =~ s/ /%20/g; $loc =~ s/ /%20/g;
@@ -60,26 +61,25 @@ sub weather
# And send to channel # And send to channel
if (!ref($d->{observation_location}->{country})) { if (!ref($d->{observation_location}->{country})) {
my $windc = $d->{wind_string}; my $windc = $d->{wind_string};
if (substr($windc, length($windc) - 1, 1) eq " ") { $windc = substr($windc, 0, length($windc) - 1); } if (substr($windc, length($windc) - 1, 1) eq " ") { $windc = substr($windc, 0, length($windc) - 1) }
privmsg($src->{svr}, $src->{chan}, "Results for \2".$d->{observation_location}->{full}."\2 - \2Temperature:\2 ".$d->{temperature_string}." \2Wind Conditions:\2 ".$windc." \2Conditions:\2 ".$d->{weather}); privmsg($src->{svr}, $src->{chan}, "Results for \2".$d->{observation_location}->{full}."\2 - \2Temperature:\2 ".$d->{temperature_string}." \2Wind Conditions:\2 ".$windc." \2Conditions:\2 ".$d->{weather});
privmsg($src->{svr}, $src->{chan}, "\2Heat index:\2 ".$d->{heat_index_string}." \2Humidity:\2 ".$d->{relative_humidity}." \2Pressure:\2 ".$d->{pressure_string}." - ".$d->{observation_time}); privmsg($src->{svr}, $src->{chan}, "\2Heat index:\2 ".$d->{heat_index_string}." \2Humidity:\2 ".$d->{relative_humidity}." \2Pressure:\2 ".$d->{pressure_string}." - ".$d->{observation_time});
} }
else { else {
# Otherwise, send an error message. # Otherwise, send an error message.
privmsg($src->{svr}, $src->{chan}, "Location not found."); privmsg($src->{svr}, $src->{chan}, 'Location not found.');
} }
} }
else { else {
# Otherwise, send an error message. # Otherwise, send an error message.
privmsg($src->{svr}, $src->{chan}, "An error occurred while retrieving your weather."); privmsg($src->{svr}, $src->{chan}, 'An error occurred while retrieving your weather.');
} }
return 1; return 1;
} }
# Start initialization. # Start initialization.
API::Std::mod_init('Weather', 'Xelhua', '1.00', '3.0.0a4', __PACKAGE__); API::Std::mod_init('Weather', 'Xelhua', '1.00', '3.0.0a10');
# vim: set ai sw=4 ts=4:
# build: cpan=LWP::UserAgent,XML::Simple perl=5.010000 # build: cpan=LWP::UserAgent,XML::Simple perl=5.010000
__END__ __END__
@@ -121,6 +121,8 @@ From the NE at 9 MPH Gusting to 22 MPH Conditions: Overcast
This module requires LWP::UserAgent and XML::Simple. Both are This module requires LWP::UserAgent and XML::Simple. Both are
obtainable from CPAN <http://www.cpan.org>. obtainable from CPAN <http://www.cpan.org>.
This module is compatible with Auto version 3.0.0a4+. This module is compatible with Auto version 3.0.0a10+.
=back =back
# vim: set ai et sw=4 ts=4:
+2248
View File
File diff suppressed because it is too large. Load diff
+373
View File
@@ -0,0 +1,373 @@
# Module: WerewolfAdmin. See below for documentation.
# Copyright (C) 2010-2011 Xelhua Development Group, et al.
# This program is free software; rights to this code are stated in doc/LICENSE.
package M::WerewolfAdmin;
use strict;
use warnings;
use feature qw(switch);
use API::Std qw(cmd_add cmd_del timer_add timer_del trans conf_get);
use API::IRC qw(privmsg notice cmode ison);
# Initialization subroutine.
sub _init {
# Create the WOLFA command.
cmd_add('WOLFA', 0, 'werewolf.admin', \%M::WerewolfAdmin::HELP_WOLFA, \&M::WerewolfAdmin::cmd_wolfa) or return;
# Success.
return 1;
}
# Void subroutine.
sub _void {
# Delete the WOLFA command.
cmd_del('WOLFA') or return;
# Success.
return 1;
}
# Help hash for the WOLFA command.
our %HELP_WOLFA = (
en => "This command allows you to perform various administrative actions in a game of Werewolf (A.K.A. Mafia). \2Syntax:\2 WOLFA (JOIN|WAIT|START|KICK|STOP) [parameters]",
);
# Callback for the WOLFA command.
sub cmd_wolfa {
my ($src, @argv) = @_;
# We require at least one parameter.
if (!defined $argv[0]) {
notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.});
return;
}
# Iterate the parameter.
given (uc $argv[0]) {
when (/^(JOIN|J)$/) {
# WOLFA JOIN
# Requires an extra parameter.
if (!defined $argv[1]) {
notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.});
return;
}
# Check if a game is running.
if (!$M::Werewolf::PGAME and !$M::Werewolf::GAME) {
notice($src->{svr}, $src->{nick}, 'No game is currently running.');
}
elsif ($M::Werewolf::GAME) {
notice($src->{svr}, $src->{nick}, 'Sorry, but the game is already running. Try again next time.');
}
else {
# Check if this is the game channel.
if ($src->{svr}.'/'.$src->{chan} ne $M::Werewolf::GAMECHAN) {
notice($src->{svr}, $src->{nick}, "Werewolf is currently running in \2$M::Werewolf::GAMECHAN\2.");
return;
}
# Check if this user exists in channel.
if (!ison($src->{svr}, $src->{chan}, lc $argv[1])) {
notice($src->{svr}, $src->{nick}, "No such user \2$argv[1]\2 is on the channel.");
return;
}
# Make sure they're not already playing.
if (exists $M::Werewolf::PLAYERS{lc $argv[1]}) {
notice($src->{svr}, $src->{nick}, 'They\'re already playing!');
return;
}
# Set variables.
$M::Werewolf::PLAYERS{lc $argv[1]} = 0;
my $nick = $M::Werewolf::NICKS{lc $argv[1]} = $Core::IRC::Users::users{$src->{svr}}{lc $argv[1]};
# Send message.
my ($gsvr, $gchan) = split '/', $M::Werewolf::GAMECHAN, 2;
cmode($gsvr, $gchan, "+v $nick");
privmsg($gsvr, $gchan, "\2$nick\2 was forced to join the game by \2$src->{nick}\2.");
}
}
when (/^(WAIT|W)$/) {
# WOLFA WAIT
# Check if a game is running.
if (!$M::Werewolf::PGAME) {
if (!$M::Werewolf::GAME) {
notice($src->{svr}, $src->{nick}, 'No game is currently running.');
return;
}
else {
notice($src->{svr}, $src->{nick}, 'Werewolf is already in play.');
return;
}
}
# Check if this is the game channel.
if ($src->{svr}.'/'.$src->{chan} ne $M::Werewolf::GAMECHAN) {
notice($src->{svr}, $src->{nick}, "Werewolf is currently running in \2$M::Werewolf::GAMECHAN\2.");
return;
}
# Increase WAIT.
$M::Werewolf::WAIT += 20;
# And WAITED.
$M::Werewolf::WAITED++;
privmsg($src->{svr}, $src->{chan}, "\2$src->{nick}\2 forcibly increased join wait time by 20 seconds.");
}
when ('START') {
# WOLFA START
# Check if a game is running.
if (!$M::Werewolf::PGAME) {
if (!$M::Werewolf::GAME) {
notice($src->{svr}, $src->{nick}, 'No game is currently running.');
return;
}
else {
notice($src->{svr}, $src->{nick}, 'Werewolf is already in play.');
return;
}
}
# Check if this is the game channel.
if ($src->{svr}.'/'.$src->{chan} ne $M::Werewolf::GAMECHAN) {
notice($src->{svr}, $src->{nick}, "Werewolf is currently running in \2$M::Werewolf::GAMECHAN\2.");
return;
}
# Need four or more players.
if (keys %M::Werewolf::PLAYERS < 4) {
privmsg($src->{svr}, $src->{chan}, "$src->{nick}: Four or more players are required to play.");
return;
}
# First, determine how many players to declare a wolf.
my $cwolves = POSIX::ceil(keys(%M::Werewolf::PLAYERS) * .14);
# Only one seer, harlot, guardian angel, traitor and detective.
my $cseers = 1;
my $charlots = my $cdrunks = my $cangels = my $ctraitors = my $cdetectives = 0;
if (keys %M::Werewolf::PLAYERS >= 6) { $charlots++ unless conf_get('werewolf:rated-g') }
if (keys %M::Werewolf::PLAYERS >= 7) { $cdrunks++ unless conf_get('werewolf:rated-g') }
if (keys %M::Werewolf::PLAYERS >= 9) { $cangels++ unless conf_get('werewolf:no-angels') }
if (keys %M::Werewolf::PLAYERS >= 12 and conf_get('werewolf:traitors')) { $ctraitors++ }
if (keys %M::Werewolf::PLAYERS >= 16 and conf_get('werewolf:detectives')) { $cdetectives++ }
# Give all players a role.
foreach my $plyr (keys %M::Werewolf::PLAYERS) { $M::Werewolf::PLAYERS{$plyr} = 'v' }
# Push players into a temporary array.
my @plyrs = keys %M::Werewolf::PLAYERS;
# Set wolves.
while ($cwolves > 0) {
my $rpi = $plyrs[int rand scalar @plyrs];
if ($M::Werewolf::PLAYERS{$rpi} !~ m/^(w|s|g|h|d|t)$/xsm) {
$M::Werewolf::PLAYERS{$rpi} = 'w';
$cwolves--;
$M::Werewolf::STATIC[0] .= ", \2$M::Werewolf::NICKS{$rpi}\2";
}
}
$M::Werewolf::STATIC[0] = substr $M::Werewolf::STATIC[0], 2;
# Set seers.
while ($cseers > 0) {
my $rpi = $plyrs[int rand scalar @plyrs];
if ($M::Werewolf::PLAYERS{$rpi} !~ m/^(w|g|h|d|t)$/xsm) {
$M::Werewolf::PLAYERS{$rpi} = 's';
$cseers--;
$M::Werewolf::STATIC[1] = "\2$M::Werewolf::NICKS{$rpi}\2";
}
}
# Set harlots.
while ($charlots > 0) {
my $rpi = $plyrs[int rand scalar @plyrs];
if ($M::Werewolf::PLAYERS{$rpi} !~ m/^(w|g|s|d|t)$/xsm) {
$M::Werewolf::PLAYERS{$rpi} = 'h';
$charlots--;
$M::Werewolf::STATIC[2] = "\2$M::Werewolf::NICKS{$rpi}\2";
}
}
# Set drunks.
while ($cdrunks > 0) {
my $rpi = $plyrs[int rand scalar @plyrs];
if ($M::Werewolf::PLAYERS{$rpi} =~ m/v/xsm) {
$M::Werewolf::PLAYERS{$rpi} = 'vi';
$cdrunks--;
}
}
# Set guardian angels.
while ($cangels > 0) {
my $rpi = $plyrs[int rand scalar @plyrs];
if ($M::Werewolf::PLAYERS{$rpi} !~ m/^(w|h|s|d|t)$/xsm) {
$M::Werewolf::PLAYERS{$rpi} = 'g';
$cangels--;
$M::Werewolf::STATIC[3] = "\2$M::Werewolf::NICKS{$rpi}\2";
}
}
# Set traitors.
while ($ctraitors > 0) {
my $rpi = $plyrs[int rand scalar @plyrs];
if ($M::Werewolf::PLAYERS{$rpi} !~ m/^(w|h|s|d|g)$/xsm) {
$M::Werewolf::PLAYERS{$rpi} = 't';
$ctraitors--;
$M::Werewolf::STATIC[4] = "\2$M::Werewolf::NICKS{$rpi}\2";
}
}
# Set detectives.
while ($cdetectives > 0) {
my $rpi = $plyrs[int rand scalar @plyrs];
if ($M::Werewolf::PLAYERS{$rpi} !~ m/^(w|h|s|g|t)$/xsm) {
$M::Werewolf::PLAYERS{$rpi} = 'd';
$cdetectives--;
$M::Werewolf::STATIC[5] = "\2$M::Werewolf::NICKS{$rpi}\2";
}
}
# If there's 8 or more players, give one of them a gun.
if (keys %M::Werewolf::PLAYERS >= 8) {
my $rpi = $plyrs[int rand scalar @plyrs];
while ($M::Werewolf::PLAYERS{$rpi} =~ m/w/xsm || $M::Werewolf::PLAYERS{$rpi} =~ m/t/xsm) { $rpi = $plyrs[int rand scalar @plyrs] }
$M::Werewolf::PLAYERS{$rpi} .= 'b';
# And give them PLAYER COUNT * .12 bullets rounded up.
$M::Werewolf::BULLETS = POSIX::ceil(keys(%M::Werewolf::PLAYERS) * .12);
if ($M::Werewolf::PLAYERS{$rpi} =~ m/i/xsm) { $M::Werewolf::BULLETS = $M::Werewolf::BULLETS * 3 }
}
# Set variables.
$M::Werewolf::GAME = 1;
$M::Werewolf::PGAME = 0;
# Set spoke variables.
foreach (keys %M::Werewolf::PLAYERS) { $M::Werewolf::SPOKE{$_} = time }
# All players have their role, so lets begin the game!
my ($gsvr, $gchan) = split '/', $M::Werewolf::GAMECHAN, 2;
privmsg($gsvr, $gchan, "Game is now starting. (forced start by \2$src->{nick}\2)");
cmode($gsvr, $gchan, '+m');
# Delete waiting timer.
timer_del('werewolf.joinwait');
# Start timer for bed checking.
timer_add('werewolf.chkbed', 2, 5, \&M::Werewolf::_chkbed);
# Initialize the nighttime.
M::Werewolf::_init_night();
}
when (/^(KICK|K)$/) {
# WOLFA KICK
# Check if a game is running.
if (!$M::Werewolf::GAME and !$M::Werewolf::PGAME) {
notice($src->{svr}, $src->{nick}, 'No game is currently running.');
return;
}
# Check if this is the game channel.
if ($src->{svr}.'/'.$src->{chan} ne $M::Werewolf::GAMECHAN) {
notice($src->{svr}, $src->{nick}, "Werewolf is currently running in \2$M::Werewolf::GAMECHAN\2.");
return;
}
# Requires an extra parameter.
if (!defined $argv[1]) {
notice($src->{svr}, $src->{nick}, trans('Not enough parameters').q{.});
return;
}
# Check if the target is playing.
if (!exists $M::Werewolf::PLAYERS{lc $argv[1]}) {
notice($src->{svr}, $src->{nick}, "\2$argv[1]\2 is not currently playing.");
return;
}
# Kill the target.
privmsg($src->{svr}, $src->{chan}, "\2$argv[1]\2 died of an unknown disease. He/She was a \2".M::Werewolf::_getrole(lc $argv[1], 2)."\2.");
M::Werewolf::_player_del(lc $argv[1]);
}
when ('STOP') {
# WOLFA STOP
# Check if a game is running.
if (!$M::Werewolf::GAME and !$M::Werewolf::PGAME) {
notice($src->{svr}, $src->{nick}, 'No game is currently running.');
return;
}
# Check if this is the game channel.
if ($src->{svr}.'/'.$src->{chan} ne $M::Werewolf::GAMECHAN) {
notice($src->{svr}, $src->{nick}, "Werewolf is currently running in \2$M::Werewolf::GAMECHAN\2.");
return;
}
# End the game.
my ($gsvr, $gchan) = split '/', $M::Werewolf::GAMECHAN, 2;
privmsg($gsvr, $gchan, "\2$src->{nick}\2 is forcing the game to end...");
M::Werewolf::_gameover('n');
}
default { notice($src->{svr}, $src->{nick}, trans('Unknown action', $_).q{.}) }
}
return 1;
}
# Start initialization.
API::Std::mod_init('WerewolfAdmin', 'Xelhua', '1.00', '3.0.0a11');
# build: perl=5.010000
__END__
=head1 NAME
WerewolfAdmin - Administrative functions for Werewolf
=head1 VERSION
1.00
=head1 SYNOPSIS
None
=head1 DESCRIPTION
This module allows one to administer the Werewolf IRC game, provided by the
Werewolf module.
It provides the following commands:
WOLFA JOIN|J - Force join.
WOLFA WAIT - Force wait.
WOLFA START - Force start.
WOLFA KICK|K - Kick a player.
WOLFA STOP - Stop a game forcibly.
And requires the werewolf.admin privilege.
=head1 DEPENDENCIES
This module depends on the following Auto module(s):
=over
=item Werewolf
The Werewolf module provides the game that this module provides administrative
commands for. Using this module without Werewolf will likely cause a fatal
error.
=back
=head1 AUTHOR
This module was written by Elijah Perrault.
This module is maintained by Xelhua Development Group.
=head1 LICENSE AND COPYRIGHT
This module is Copyright (C) 2010-2011, Xelhua Development Group.
This module is released under the same terms as Auto itself.
=cut
# vim: set ai et ts=4 sw=4:
+70
View File
@@ -0,0 +1,70 @@
# OSI-approved software licenses as of February 26, 2011.
my %licenses = (
auto => 'Same license as Auto itself',
afl => 'Academic Free License',
agpl => 'Affero GNU Public License',
apl => 'Adaptive Public License',
apache => 'Apache License',
apsl => 'Apple Public Source License',
art => 'Artistic License',
aal => 'Attribution Assurance License',
nbsd => 'New BSD License',
sbsd => 'Simplified BSD License',
bsl => 'Boost Software License',
catosl => 'Computer Associates Trusted Open Source License',
cddl => 'Common Development and Distribution License',
cpal => 'Common Public Attribution License',
cua => 'CUA Office Public License',
eudgsl => 'EU DataGrid Software License',
epl => 'Eclipse Public License',
ecl => 'Educational Community License',
efl => 'Eiffel Forum License',
enpl => 'Entessa Public License',
eupl => 'European Union Public License',
fair => 'Fair License',
fwl => 'Frameworx License',
gpl2 => 'GNU General Public License v2',
gpl3 => 'GNU General Public License v3',
lgpl => 'GNU Lesser General Public License',
ibm => 'IBM Public License',
ipa => 'IPA Font License',
isc => 'ISC License',
lppl => 'LaTeX Project Public License',
lpl => 'Lucent Public License',
miros => 'MirOS Licence',
mspl => 'Microsoft Public License',
msrl => 'Microsoft Reciprocal License',
mit => 'MIT License',
msl => 'Motosoto License',
mpl => 'Mozilla Public License',
mtl => 'Multics License',
nasa => 'NASA Open Source Agreement',
ntpl => 'NTP License',
naumen => 'Naumen Public License',
nhgpl => 'Nethack General Public License',
nosl => 'Nokia Open Source License',
nposl => 'Non-Profit Open Software License',
oclc => 'OCLC Research Public License',
ofl => 'Open Font License',
ogtsl => 'Open Group Test Suite License',
osl => 'Open Software License',
php => 'PHP License',
pgsql => 'The PostgreSQL License',
python => 'Python License',
pysfl => 'Python Software Foundation License',
qpl => 'Qt Public License',
real => 'RealNetworks Public Source License',
rpl => 'Reciprocal Public License',
rscpl => 'Ricoh Source Code Public License',
simple => 'Simple Public License',
scl => 'Sleepycat License',
spl => 'Sun Public License',
sowpl => 'Sybase Open Watcom Public License',
ncsa => 'University of Illinois/NCSA Open Source License',
vsl => 'Vovida Software License',
w3c => 'W3C License',
wxwll => 'wxWindows Library License',
xnet => 'X.Net License',
zpl => 'Zope Public License',
zlib => 'zlib/libpng license'
);
View File
File renamed without changes.