Initial commit for PCCC 3.0

master
Noah 2013-12-02 12:16:44 -08:00
commit 6f98737331
35 changed files with 7067 additions and 0 deletions

171
CHANGES.txt Normal file
View File

@ -0,0 +1,171 @@
+--------------------------+
| Perl CyanChat Client 2.x |
+--------------------------+
3.0 Jun 21 2007
- Made some changes to the Debug Window:
- The output filehandles (STDOUT; STDERR) are no longer bound to this window; they're
sent to the terminal (if present) like default.
- Only CC packets are displayed in the Debug Window. Server packets are in blue text,
and client packets are in red.
- Changed the default Special Guest color back to orange, and the action color back
to yellow.
- Built in support for "profiles." Your configuration, ignore lists, and chat logs
are now saved in your home directory instead of in PCCC's directory. So on Linux
this means /home/username/.pccc, and WinXP is C:/Documents and Settings/user/PCCC
- Made a minor edit to the Net::CyanChat library, so that it can detect when the
server has banned you from the room.
- Added support for sound effects. It uses the Win32::MediaPlayer module on Windows,
or the system command `play` on Linux.
- Added a "Force Quit" command under the File Menu. It's disabled by default. When
you attempt at least once to exit the program properly, and it for whatever reason
fails to exit, the Force Quit option becomes enabled. Alternatively, the keyboard
shortcut Ctrl+Alt+Q will kill the program.
- Moved the configuration options for MutualIgnore, LoudIgnore, and SendIgnore to
the bottom of the "Ignored Users" tab.
- Created a "Sounds" tab, with configurable options for:
- Enable sounds -- disable this, and all sounds are disabled.
- Play sounds on certain events...
- When a user joins the room
- When a user exits the room
- When a public message is received
- When a private message is received
- Added a "Mute sounds" option to the bottom of the Chat menu. This option will
temporarily disable sounds, but not permanently save this state to your config
file.
- Changed how action messages ("/me") and typo messages appear. The new style is:
Action Messages: ** Nickname performs an action **
Typo Messages: [Nickname] *their typo correction
All the text is in the action text color except for the nickname, and in the case
of typo messages, the brackets around the nick. In typo corrections, the user's exact
message is shown as usual, just in yellow text instead of silver.
- Reprogrammed the entire help system. It now uses Tk::HyperText and renders HTML
documents from the "docs" folder. Also, added an "About" menu option to the Help menu,
which opens the appropriate page in the Help Viewer. Also, "Help" buttons on the
Preferences window will load the appropriate page in the Help Viewer too.
- Bug fix: when copying/pasting text from an outside source (e.g. from a web page)
into the typing space, the newline characters would be preserved when they shouldn't
be. Sending the message would result in getting banned from Cho. This has been fixed
now, as the characters \x0d (Cr) and \x0a (Lf) are filtered out of your message.
- Bug fix: got rid of the right-click context menus on the Who List. For Windows users,
right-clicking and bringing up this menu would pause the main program loop, effectively
preventing PCCC from polling the server for new events. The GUI would still work just fine,
but the loop wouldn't work anymore.
2.8 Jun 1 2007
- Removed the "highlight borders" on the widgets, so that Linux and Mac users don't
have to see those ugly borders around i.e. the "Autoscroll" check box, as well as
buttons and text boxes.
- Redesigned the preferences window.
- Added the option of *not* showing private messages in new IM windows. When the
option is disabled, private messages only show up in IM windows if an IM window
already exists, and the only way to create an IM window is to double-click a name
in the Who List.
- Added right-click context menus to the Who List. Right-clicking a user displays a
context menu along the lines of:
Username:address
----------------
Send private message
Ignore user
... or "Unignore user" if you already ignored them.
- Added an "Ignored Users" tab to the Preferences window, where you can view your
ignore list, adding or removing users if necessary.
- Added "Notifications" -- when a new message arrives (in public chat or private
message windows), and the window is out of focus or minimized, the window title
will animate to get your attention.
- Added an "Auto-logging" option, which will automatically log all messages received
in chat. It saves them into "./logs/yyyy-mm-dd/yyyymmdd-x.html", where yyyymmdd is a
date stamp, and x is a session number starting from 1, which increments each time PCCC
is run.
- Bug Fixes:
- Fixed the "disappearing name" bug (where you'd log in to chat, open the Preferences
window, hit Cancel, and your nick in the Name: box would revert to the "default nick"
from the preferences, which is blank by default).
- Added configuration options:
- TimeStamps: show time stamps on all messages.
- IMWindows: show private messages in new "IM" windows
2.7 May 23 2007
- The client now assumes "htmlview" as the default "Browser Command" when you're not
on Windows and there is no config file yet. Otherwise, the default is "start"
2.6 Apr 14 2007
- Added the "Browser Command" option, to specify the console command used to open your
web browser. Windows users can just leave this as "start", but Linux users will have
to specify "firefox", "mozilla", or another command.
- Added a "Reverse Orientation" option. Users that are familiar with most traditional
chat programs, in which the message typing space is below the conversation space,
will want to enable this option (in conjunction with unchecking "Reverse chat dialog").
- Made the Preferences and Enter Raw Command windows a little bit bigger. The "Ok"
button was being squished on Linux, and the Enter Raw Command's buttons weren't even
visible before.
- Updated the help file with information about the new options added.
2.5 Mar 1 2007
- Two more Frame widgets added to the user interface. Now the window "scales" better
(when you maximize the window, the input box stays at the top and the dialog window
stretches to fill all the remaining space; previously, the dialog window and input
box would fight for the new space, causing a lot of unnecessary padding above and below
the input box).
- Added hyperlinking support for the main chat dialog window (but not yet for private
message windows).
2.4 Jan 29 2007
- Added a checkbutton to enable/disable the automatic scrolling of the chat window when
new messages are received.
- The "Disconnect" menu option is disabled from the start if you are not connected yet,
like it should've been.
- The Who List gets wiped clean when you disconnect from the server. The lack of doing this
used to cause problems where people in the Who List weren't actually in the chat room,
so clearing the list fixes this problem.
- Made sure I don't forget to include the latest version of Net::CyanChat in the source
distribution this time. ;)
2.3 Nov 7 2006
- Minor bug fixes.
2.2 Oct 30 2006
- Added more color variables: the main window background/foreground and the button
background/foreground is now configurable separate from the rest of the screen.
The WhoList can have a different background than the dialog window.
- The "Save Transcript" now saves the conversation as XHTML, keeping the colors of the chat.
If you save it to a text file, it ignores the formatting (the old behavior of PCCC).
- Action messages have changed display formats:
Old Way: *** [username] action ***
New Way: [username] action in yellow ("action") text color
- Outgoing private messages are echoed in the chat dialog window, even if you sent them in
a separate PM window.
- Added some new configuration options:
- AutoAct: when a message starts and ends with *'s, it will be treated like a /me action.
- LoudTypo: when a message starts with a * (typically for typo corrections), a notification
will be shown about the typo being corrected.
- Added a full documentation system. Click "Help -> Contents"
- Bug fixes:
- Private message windows now auto-scroll.
2.1 Oct 24 2006
- Added new configuration options:
- AutoJoin: automatically join the room on connect (if Nickname has a length)
- BlockServer: ignore private messages from ChatServer (when on debug port 1813)
- LoudIgnore: show a notification when somebody blocks you
- SendIgnore: send the ignore command to the server when you ignore somebody
- IgnoreBack: perform a mutual ignore when ignored (ignore the one ingoring you)
- Added the ability to reset the configuration to the defaults.
- The entire window now recolors itself when you change color settings (rather than just
the conversation window)
- A disconnect handler has been added so the client knows when you've been disconnected
from the chat server.
- Added the ability to automatically reconnect on disconnect. This functionality is limited
though. It won't keep trying. But this will solve the quick temporary disconnects experienced
on wireless Internet connections.
- A few bugs have been fixed:
- The Preferences window now has a fixed default width and height. Previously, it
was leaving it up to the window contents to automatically adjust its size, but this
didn't work on *nix platforms and the window was too small.
- The "Connection Details" window has a fixed default width and height too, for same reasons.
- Private Message windows will come back now. Previously, if you opened a private message
window with somebody, then closed that window, you couldn't reopen it (unless the other
person sent you a message to open the window).
2.0 Oct 1 2006
- Initial release.

3522
PCCC.pl Executable file

File diff suppressed because it is too large Load Diff

140
README.md Normal file
View File

@ -0,0 +1,140 @@
# Perl CyanChat Client
## I. About PCCC
Perl CyanChat Client 2.x is a complete rewrite from the original
1.x versions. The new client uses `Net::CyanChat` to connect to
the CyanChat servers instead of having the code included within
PCCC's own code.
PCCC 1.x was actually written prior to Net::CyanChat which I
created AFTER making PCCC 1.x, so the new PCCC makes up for that.
## II. About CyanChat
CyanChat is the name of a chat room which is owned by Cyan Worlds,
Inc. (formerly known simply as Cyan). They created some really good
adventure games named Myst and Riven (and Myst III and then Myst IV
and V too), as well as a few other spinoff games such as Uru and
RealMyst.
The chat server was programmed by Mark Deforest of Cyan Worlds. The
chat room was created so that fans of Cyan could have a place to
meet and discuss their games and novels and interact with other fans.
The "CyanChat Community" is made up of a small number of members who
have been with CyanChat for years and years (I first went to CyanChat
like six years ago and the same group of people are still here today!)
The official homepage to CyanChat is: http://cho.cyan.com/chat/
## III. CyanChat Rules and Policies
Official Rules Page: http://cho.cyan.com/chat/rules.html
* Be respectful of and sensitive to others.
* Please, no platform wars ("my computer is better than yours").
* Keep it "G" rated; in other words, suitable for family viewing.
* No flooding, in other words, filling the screen with junk.
* But most of all HAVE FUN!
### A. Impersonating
No name or handle is reserved for any one person.
However, purposely impersonating someone for personal
gain or in disrespect of the person being impersonated
will not be tolerated. So, please try to find a
unique name for yourself.
### B. Being Banned
The CyanChat server has a bad language filter that
watches all the messages being sent. If it detects
that you have used bad language, depending how severe,
it might automatically ban you from using CyanChat,
ban you for a day or just censor the message. Once
you have been banned you will get a message when you
start CyanChat that your IP address has been blocked
from using CyanChat.
### C. Getting Unbanned
There are many reasons why an IP address might be banned
from CyanChat, some reasons are accidental, such as misspelling
a word. If you've gotten accidentally banned, e-mail markd@cyan.com
with the IP address that is banned. But one thing to
remember is that I have a log of all the bannings (and what
was said) and its usually quite obvious, so don't try the
"accident" angle unless it really was.
## IV. Configuring PCCC
After running PCCC for the first time, you can configure CyanChat
by choosing "Edit -> Preferences". The client assumes a number of default
preferences, which you can change. If you want to restore them to their
defaults, either delete "config.txt" and restart the program, or click
"Restore Defaults" in the preferences window.
## V. Using PCCC
When you open PCCC, it should connect automatically unless you specified
that it shouldn't. In that case, click "Connection -> Connect" on the menu
bar to connect to CyanChat.
When connected, you will receive a lot of messages from ChatServer. These
are introduction messages.
Type a nickname for yourself in the box next to the word "Name:" toward
the top of the window. Then click "Join Chat" to enter the room. Note that
nicknames can be no longer than 20 characters and that they can't contain
the pipe symbol `|`.
Write messages into the long text box above the chat dialog space. To send
a private message to somebody, there are three options you can use:
1. Write a message into the normal message space, then single-click
the target's name from the Who List, and click "Send Private"
2. Double-click a user's name from the Who List to open a Private
Message window. Type your message into this window and hit Enter.
3. In the normal message space, type `/whisper <name> <message>`,
substituting a user's name for `<name>` and a message for `<message>`.
To exit the chat room, click the "Exit Chat" button. To disconnect from
CyanChat, click "Connection -> Disconnect". Doing this will also sign you
out if you are currently signed in to the chat room.
Exiting PCCC via "File -> Exit" will also sign you out and disconnect you
where applicable. Closing out of the program in any other means will result
in a "disconnect", where CyanChat will simply tell the other users that you
were disconnected rather than that you signed out properly.
## VI. Installation
Perl CyanChat Client should work fine on all operating systems. It mostly
uses the standard Tk modules from Tk version 804.027
In addition to the standard Tk modules, the following nonstandard modules
may need to be installed:
Net::CyanChat 0.04 or higher.
These modules have been included in the standard distribution of
Perl CyanChat Client.
## VII. License and Copyright
Perl CyanChat Client
Copyright (C) 2006-13 Noah Petherbridge
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License along
with this program; if not, write to the Free Software Foundation, Inc.,
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

BIN
balloon.gif Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 726 B

13
docs/404.html Normal file
View File

@ -0,0 +1,13 @@
<html>
<head>
<title>Error 404</title>
</head>
<body bgcolor="#FFFFEE" link="#009900" vlink="#990099" alink="#009900" text="#000000">
<basefont face="Arial" size="3" color="#000000">
<h1>404 Error</h1>
The page you requested was not found.
</body>
</html>

27
docs/about.html Normal file
View File

@ -0,0 +1,27 @@
<html>
<head>
<title>About PCCC</title>
</head>
<body bgcolor="#FFFFEE" link="#0000FF" vlink="#990099" alink="#009900" text="#000000">
<basefont face="Arial" size="3" color="#000000">
<h1>About Perl CyanChat Client</h1>
The Perl CyanChat Client (<b>PCCC</b>) is a program used for chatting on the
<a href="http://www.cyanworlds.com/" target="_blank">Cyan Worlds</a> chat room.
It was written using the programming language
<a href="http://www.perl.com/" target="_blank">Perl</a>, and the Tk graphical
user interface.
<h1>About CyanChat</h1>
CyanChat is the name of the chat room of Cyan Worlds, Inc., where the fans of
Cyan's games and novels can meet and chat with one another.
<h1>PCCC Version</h1>
You are running Perl CyanChat Client version <b>%VERSION%</b> (%DATE%).<p>
Running on Net::CyanChat v. %CC% and Tk::HyperText v. %HTML%
</body>
</html>

36
docs/action.html Normal file
View File

@ -0,0 +1,36 @@
<html>
<head>
<title>Action Messages</title>
</head>
<body bgcolor="#FFFFEE" link="#0000FF" vlink="#990099" alink="#009900" text="#000000">
<basefont face="Arial" size="3" color="#000000">
<h1>Action Messages</h1>
"Action Messages" are a bit of an extension to the CyanChat protocol. It's not
actually supported on the CC server, but several home-made CC clients support
this.
<h2>IRC-Style /me Actions</h2>
Typing in "/me &lt;action&gt;" in the message space is the standard way of sending
an action message. To all clients who support the feature, your message should appear
special on their client. To those which don't support the feature, they'll simply
see "/me &lt;action&gt;" from you.
<h2>Automatic Actions</h2>
There is an option on the <a href="misc.html">Miscellaneous</a> tab of the Preferences
window which will automatically display certain messages in the "action" format.<p>
When enabled, a message that begins and ends with asterisks (*) will automatically be
displayed as action messages.
<h2>Typo Messages</h2>
Typo messages are similar to action messages in that they display in a special color.
When a message is received that begins with a * but doesn't end with one, the message
is displayed normally, but the text is displayed in the "action color"
</body>
</html>

33
docs/colors.html Normal file
View File

@ -0,0 +1,33 @@
<html>
<head>
<title>Color Preferences</title>
</head>
<body bgcolor="#FFFFEE" link="#0000FF" vlink="#990099" alink="#009900" text="#000000">
<basefont face="Arial" size="3" color="#000000">
<h1>Preferences: Colors</h1>
<h2>Chat Colors</h2>
<blockquote>
<b>PCCC Interface</b>
<blockquote>
These colors will determine elements on the main window of PCCC, separate from
the chat dialog window within.
</blockquote>
<b>Chat Colors</b>
<blockquote>
These control the general color scheme of the dialog window, such as text
colors related to private messages, actions, and hyperlinks.
</blockquote>
<b>Nickname Colors</b>
<blockquote>
These control the colors of different nickname types within the dialog
window.
</blockquote>
</blockquote>
</body>
</html>

36
docs/connection.html Normal file
View File

@ -0,0 +1,36 @@
<html>
<head>
<title>Connection Preferences</title>
</head>
<body bgcolor="#FFFFEE" link="#0000FF" vlink="#990099" alink="#009900" text="#000000">
<basefont face="Arial" size="3" color="#000000">
<h1>Preferences: Connection</h1>
<h2>Server Settings</h2>
<blockquote>
<b>CyanChat Host</b>
<blockquote>
The name of the CC server. Default is <code>cho.cyan.com</code>
</blockquote>
<b>Port</b>
<blockquote>
The port that the CC server will listen to you from. Default is <code>1812</code>,
while port <code>1813</code> is used for testing.
</blockquote>
<b>Automatically connect when PCCC starts</b>
<blockquote>
When checked, PCCC will automatically connect to the server when it starts.
</blockquote>
<b>Attempt to reconnect when disconnected</b>
<blockquote>
When checked, PCCC will attempt to reconnect when it has been disconnected.
</blockquote>
</blockquote>
</body>
</html>

26
docs/console.html Normal file
View File

@ -0,0 +1,26 @@
<html>
<head>
<title>Chat Console</title>
</head>
<body bgcolor="#FFFFEE" link="#0000FF" vlink="#990099" alink="#009900" text="#000000">
<basefont face="Arial" size="3" color="#000000">
<h1>Chat Console</h1>
The <b>Chat Console</b> (also known as the Debug Window) is a small window that
monitors all incoming and outgoing TCP packets. It's useful as a debugging tool,
and to see what's really going on in the background during your CC connection.<p>
Messages sent from your client to the server appear in <font color="#FF0000">red</font>
text, while messages received from the server are in <font color="#0000FF">blue</font>.<p>
Note that the chat console <b>does not</b> automatically scroll so long as you have
the window opened. This is actually more useful for debugging purposes than having
the window keep scrolling to the bottom constantly. However, when you first open the
window, it will automatically jump to the bottom.<p>
To make the window disappear, click the "Dismiss" button. The "X" button on the title
bar won't close the window.
</body>
</html>

25
docs/cyan.html Normal file
View File

@ -0,0 +1,25 @@
<html>
<head>
<title>Cyan Staff</title>
</head>
<body bgcolor="#FFFFEE" link="#0000FF" vlink="#990099" alink="#009900" text="#000000">
<basefont face="Arial" size="3" color="#000000">
<h1>Cyan Staff</h1>
The Cyan Staff (also known as Cyanites or Cyantists) are the staff members of the
company Cyan Worlds. When they enter the chat room, their "link in" message will
read: "&lt;links in from Cyan Worlds, Inc.&gt;"<p>
Additionally, their nicknames will be placed in the "Cyan &amp; Guests" list instead
of the standard Who List, and their names will appear in
<font color="#00FFFF" back="#000000">cyan</font> text.
<h1>Special Guests</h1>
Occasionally, a Cyantist will promote a regular user to the level of "Special Guest".
Special Guests also appear in the special "Cyan &amp; Guests" list, and their nicknames
will appear in <font color="#FF9900" back="#000000">orange</font> text.
</body>
</html>

15
docs/details.html Normal file
View File

@ -0,0 +1,15 @@
<html>
<head>
<title>Connection Details</title>
</head>
<body bgcolor="#FFFFEE" link="#0000FF" vlink="#990099" alink="#009900" text="#000000">
<basefont face="Arial" size="3" color="#000000">
<h1>Connection Details</h1>
This window is relatively useless. It lists the server, port, and connection
status. If it recognizes the server or the port to be CC standard, it will
display a notification next to it.
</body>
</html>

82
docs/general.html Normal file
View File

@ -0,0 +1,82 @@
<html>
<head>
<title>General Preferences</title>
</head>
<body bgcolor="#FFFFEE" link="#0000FF" vlink="#990099" alink="#009900" text="#000000">
<basefont face="Arial" size="3" color="#000000">
<h1>Preferences: General</h1>
<h2>Appearance</h2>
<blockquote>
<b>Main Font Face</b>
<blockquote>
This font face is used in the chat dialog window, as well as on all
of the GUI elements everywhere else in the program (on labels, buttons,
text boxes, etc.)
</blockquote>
<b>Font Size</b>
<blockquote>
Specify the main font size, in pixels.
</blockquote>
<b>Dialog Flow</b>
<blockquote>
<u>New messages on top (default CC behavior)</u>
<blockquote>
When new messages are received, they'll appear at the top
of the dialog window. This is how the standard client
behaves.
</blockquote>
<u>New messages on bottom</u>
<blockquote>
This mimics the behavior of most other chat programs. New
messages will appear on the bottom.
</blockquote>
</blockquote>
<b>Display Options</b>
<blockquote>
<u>Reverse orientation</u>
<blockquote>
When checked, the message space will start appearing beneath
the dialog window, like most other chat programs. Changing
this option requires a restart of the program.
</blockquote>
<u>Animate the window titles when new messages arrive</u>
<blockquote>
When checked, the titles of the main window and message
windows will animate when a new message arrives while the
window is out of focus or minimized.
</blockquote>
<u>Automatically log all transcripts</u>
<blockquote>
When checked, all messages are automatically logged to
HTML files. They're saved in your profile directory. See
<a href="profile.html">User Profiles</a> for more information.
</blockquote>
</blockquote>
</blockquote>
<h2>Nickname Settings</h2>
<blockquote>
<b>Default Nickname:</b>
<blockquote>
This nickname will be automatically filled in to the "Name" box
when you start up PCCC.
</blockquote>
<b>Automatically join chat when connected</b>
<blockquote>
When checked, you will automatically join the chat room when you
connect (provided you have a nickname entered at the time).
</blockquote>
</blockquote>
</body>
</html>

24
docs/ignore.html Normal file
View File

@ -0,0 +1,24 @@
<html>
<head>
<title>Ignoring Users</title>
</head>
<body bgcolor="#FFFFEE" link="#0000FF" vlink="#990099" alink="#009900" text="#000000">
<basefont face="Arial" size="3" color="#000000">
<h1>Ignoring Users</h1>
If a user is being annoying, you can ignore them by selecting their name on the
Who List and pressing the "Ignore" button below.<p>
You can also ignore/unignore users by going to the <a href="ignorelist.html">Ignored
Users</a> tab on the Preferences window.<p>
You can unignore users by selecting their name on the Who List and pressing the
"Ignore" button again.
<h2>Advanced Ignore Options</h2>
See the <a href="ignorelist.html">Ignored Users</a> page for more information.
</body>
</html>

59
docs/ignorelist.html Normal file
View File

@ -0,0 +1,59 @@
<html>
<head>
<title>Ignored Users Preferences</title>
</head>
<body bgcolor="#FFFFEE" link="#0000FF" vlink="#990099" alink="#009900" text="#000000">
<basefont face="Arial" size="3" color="#000000">
<h1>Preferences: Ignored Users</h1>
<h2>Ignored Users</h2>
<blockquote>
<b>Online Users</b>
<blockquote>
This listbox displays all of the users currently signed in to CyanChat
(but not the ones you've ignored). Select a user from the list and press
"Ignore Selected" to move them to the Ignored Users list.
</blockquote>
<b>Ignored Users</b>
<blockquote>
This listbox displays all of the users you've ignored. Select a user from
the list and choose "Unignore Selected" to stop ignoring them.
</blockquote>
<b>Refresh Lists</b>
<blockquote>
This button will refresh the listboxes. The lists are also refreshed
each time you bring focus to the "Ignored Users" tab.
</blockquote>
<b>Remember my ignore list</b>
<blockquote>
When checked, your ignore list will be saved when you exit PCCC and
be reloaded when you start it again.
</blockquote>
<b>Perform mutual ignores</b>
<blockquote>
When checked, PCCC will automatically ignore any users who ignore us.
</blockquote>
<b>Tell me when somebody ignores me</b>
<blockquote>
When checked, you will receive a notification in the dialog window
when somebody has ignored you.
</blockquote>
<b>Send server ignore command when ignoring users</b>
<blockquote>
When checked, ignoring a user will send a standard CC ignore command
to the server. What this does is tells the server to relay your
ignore to the client in question, so that they may perform a mutual
ignore.
</blockquote>
</blockquote>
</body>
</html>

41
docs/index.html Normal file
View File

@ -0,0 +1,41 @@
<html>
<head>
<title>Contents</title>
</head>
<body bgcolor="#FFFFEE" link="#0000FF" vlink="#990099" alink="#009900" text="#000000">
<basefont face="Arial" size="3" color="#000000">
<h1>Perl CyanChat Client</h1>
<b>Getting Started</b><p>
&gt; <a href="about.html">About Perl CyanChat Client</a><br>
&gt; <a href="rules.html">CyanChat Rules</a><p>
<b>Using PCCC</b><p>
&gt; <a href="usage.html">General Usage</a><br>
&gt; <a href="profile.html">User Profiles</a><br>
&gt; <a href="pm.html">Private Messaging</a><br>
&gt; <a href="action.html">Action Messages</a><br>
&gt; <a href="ignore.html">Ignoring Users</a><br>
&gt; <a href="cyan.html">Cyan Staff</a><br>
&gt; <a href="transcript.html">Save Transcript</a><p>
<b>Configuration</b><p>
&gt; <a href="general.html">General</a><br>
&gt; <a href="connection.html">Connection</a><br>
&gt; <a href="colors.html">Colors</a><br>
&gt; <a href="ignorelist.html">Ignored Users</a><br>
&gt; <a href="sounds.html">Sounds</a><br>
&gt; <a href="misc.html">Miscellaneous</a><p>
<b>Advanced Features</b><p>
&gt; <a href="console.html">Chat Console</a><br>
&gt; <a href="raw.html">Send Raw Command</a><br>
&gt; <a href="details.html">Connection Details
</body>
</html>

73
docs/misc.html Normal file
View File

@ -0,0 +1,73 @@
<html>
<head>
<title>Miscellaneous Preferences</title>
</head>
<body bgcolor="#FFFFEE" link="#0000FF" vlink="#990099" alink="#009900" text="#000000">
<basefont face="Arial" size="3" color="#000000">
<h1>Preferences: Miscellaneous</h1>
<h2>External Programs</h2>
<blockquote>
<b>Web Browser Command</b>
<blockquote>
This is the command-line program used for launching your web
browser. The dropdown list includes the most likely programs
for each operating system, but you can type in a custom command
too (ex: "firefox")<p>
Windows users should be fine with <b>start</b><br>
Linux and Unix users should use <b>htmlview</b><br>
Mac OS users should use <b>open</b>
</blockquote>
<b>Command-line Media Player</b>
<blockquote>
This is the command-line program used for playing sound effects.
This is only applicable to Linux and Mac users. On Windows, the
module Win32::MediaPlayer is used instead.<p>
Linux users should be fine with <b>play</b>
</blockquote>
</blockquote>
<h2>Miscellaneous Options</h2>
<blockquote>
<b>Show private messages in new windows</b>
<blockquote>
When checked, all private messages will appear in their own "IM"
windows. Disable this to get the standard CC behavior back. When
disabled, IM windows can only be created by double-clicking a user's
name in the list.
</blockquote>
<b>Ignore private messages from ChatServer</b>
<blockquote>
Check this to ignore all private messages from ChatServer. This
is <b>NOT RECOMMENDED</b>. It's most useful on the test server,
where ChatServer echoes a confirmation of every little thing your
client does, but should not be used on the real server.
</blockquote>
<b>Show *...* messages as /me actions</b>
<blockquote>
This option will automatically display messages as "/me" actions
if they start and end with asterisks. See
<a href="action.html">Action Messages</a>.
</blockquote>
<b>Highlight typo corrections</b>
<blockquote>
This option will automatically display "typo" messages uniquely.
See <a href="action.html">Action Messages</a>.
</blockquote>
</blockquote>
<h2>Revert to Default Settings</h2>
This button will restore all of your configuration back to the defaults.
</body>
</html>

50
docs/pm.html Normal file
View File

@ -0,0 +1,50 @@
<html>
<head>
<title>Private Messaging</title>
</head>
<body bgcolor="#FFFFEE" link="#0000FF" vlink="#990099" alink="#009900" text="#000000">
<basefont face="Arial" size="3" color="#000000">
<h1>Private Messaging</h1>
The CyanChat server supports the sending of <b>private messages</b> to other
participants of the chat room. There are three different ways to send private
messages:
<h2>The CyanChat Way</h2>
The "CyanChat Way" is the method used in the standard CyanChat client. To send
a private message to somebody:<p>
1. Select the recipient's name from the Who List<br>
2. Type in a message to send to them.<br>
3. Press the "Send Private" button located beneath the Who List.
<h2>The IRC Way</h2>
The "IRC Way" is the method that is used on IRC chat servers (CC is not based on
IRC, but IRC users might be more familiar with this method).<p>
1. Type in "/msg &lt;recipeint&gt; &lt;message&gt;" into the message space.<br>
Example: /msg Cuvou hello there!<p>
The aliases <b>/whisper</b> and <b>/w</b> may also be used.
<h2>The IM Way</h2>
The final method, the "IM Way", is the method that is characteristic of Instant
Messaging programs. Simply double-click a user's name from the Who List and open
an Instant Message window with them.
<h1>Message Windows</h1>
Unless you disable it, the sending or receiving of private messages will always
open a message window with that user. All later private messages received from
the same user will go to this same window.<p>
If you have disabled this, then the only way to open a message window is if you
open it yourself, by double-clicking a user's name. See
<a href="misc.html">Miscellaneous Configuration Options</a>.
</body>
</html>

27
docs/profile.html Normal file
View File

@ -0,0 +1,27 @@
<html>
<head>
<title>User Profiles</title>
</head>
<body bgcolor="#FFFFEE" link="#0000FF" vlink="#990099" alink="#009900" text="#000000">
<basefont face="Arial" size="3" color="#000000">
<h1>User Profiles</h1>
PCCC saves your configuration and logs to your "user profile directory". This directory
is your home directory, plus "PCCC" or ".pccc". To locate it, read on for a list of
common places for each operating system.
<h2>Windows XP</h2>
<blockquote>
C:\Documents and Settings\<em>username</em>\PCCC
</blockquote>
<h2>Linux and Unix</h2>
<blockquote>
/home/<em>username</em>/.pccc
</blockquote>
</body>
</html>

29
docs/raw.html Normal file
View File

@ -0,0 +1,29 @@
<html>
<head>
<title>Raw Commands</title>
</head>
<body bgcolor="#FFFFEE" link="#0000FF" vlink="#990099" alink="#009900" text="#000000">
<basefont face="Arial" size="3" color="#000000">
<h1>Send Raw Command</h1>
<font size="5" color="red"><b>WARNING!!!</b></font><p>
This function of PCCC is <b>VERY</b> dangerous. The CyanChat server is very picky
about the messages it will receive from your client. If you send an improperly
formatted command, you may be banned from the server.<p>
I cannot be held responsible if you get yourself banned by using this feature.
<h2>Sending a Raw Command</h2>
To send a raw command, type it into the text box on the "Send Raw Command" window.
Press "Send Command" to send it. The "Return" key <b>will not</b> send the command
(as of version 3.0), because accidentally tapping Return and sending an incomplete
command was an easy way to get banned.<p>
Press the "Spawn Debug Window" button to open the <a href="console.html">Chat
Console</a> window.
</body>
</html>

44
docs/rules.html Normal file
View File

@ -0,0 +1,44 @@
<html>
<head>
<title>Rules</title>
</head>
<body bgcolor="#FFFFEE" link="#0000FF" vlink="#990099" alink="#009900" text="#000000">
<basefont face="Arial" size="3" color="#000000">
<h1>CyanChat Rules</h1>
* Be respectful of and sensitive to others.<br>
* Please, no platform wars ("my computer is better than yours").<br>
* Keep it "G" rated; in other words, suitable for family viewing.<br>
* No flooding, in other words, filling the screen with junk.<br>
* But most of all HAVE FUN!
<h2>Impersonating</h2>
No name or handle is reserved for any one person. However, purposely impersonating
someone for personal gain or in disrespect of the person being impersonated
will not be tolerated. So, please try to find a unique name for yourself.
<h2>Being Banned</h2>
The CyanChat server has a bad language filter that watches all the messages being
sent. If it detects that you have used bad language, depending how severe,
it might automatically ban you from using CyanChat, ban you for a day
or just censor the message. Once you have been banned you will get a message
when you start CyanChat that your IP address has been blocked from using CyanChat.
<h2>Getting Unbanned</h2>
There are many reasons why an IP address might be banned from CyanChat, some reasons
are accidental, such as misspelling a word. If you've gotten accidentally banned,
e-mail <a href="mailto:markd@cyan.com" target="_blank">markd@cyan.com</a> with the
IP address that is banned. But one thing to remember is that MarkD has a log of all
the bannings (and what was said) and it's usually quite obvious, so don't try the
"accident" angle unless it really was.<p>
<b>Offical CC Rules Page:</b>
<a href="http://cho.cyan.com/chat/rules.html" target="_blank">
http://cho.cyan.com/chat/rules.html</a>
</body>
</html>

56
docs/sounds.html Normal file
View File

@ -0,0 +1,56 @@
<html>
<head>
<title>Sound Preferences</title>
</head>
<body bgcolor="#FFFFEE" link="#0000FF" vlink="#990099" alink="#009900" text="#000000">
<basefont face="Arial" size="3" color="#000000">
<h1>Preferences: Sounds</h1>
<h2>Sound Effects</h2>
<blockquote>
<b>Enable Sound Effects</b>
<blockquote>
Check this to enable the use of sound effects globally. Disable this
to globally disable found effects.<p>
<b>NOTE:</b> To mute sound effects temporarily, just choose "Mute sounds"
from the "Chat" menu.
</blockquote>
</blockquote>
<h2>Events</h2>
<blockquote>
<b>When a user joins the room...</b>
<blockquote>
Specify a sound effect to play when a user enters the room.
</blockquote>
<b>When a user exits the room...</b>
<blockquote>
Specify a sound effect to play when a user leaves the room
(or is disconnected).
</blockquote>
<b>When a message is received...</b>
<blockquote>
Specify a sound effect to play when a user sends a public
message in the chat room.
</blockquote>
<b>When a private message is received...</b>
<blockquote>
Specify a sound effect to play when a private message is
received.
</blockquote>
</blockquote>
<h1>Adding Sound Effects</h1>
To add your own sound effects, drop the sound file into the "sfx" folder,
located within the PCCC folder.
</body>
</html>

32
docs/transcript.html Normal file
View File

@ -0,0 +1,32 @@
<html>
<head>
<title>Save Transcript</title>
</head>
<body bgcolor="#FFFFEE" link="#0000FF" vlink="#990099" alink="#009900" text="#000000">
<basefont face="Arial" size="3" color="#000000">
<h1>Save Transcript</h1>
You can save the current chat conversation by choosing "File" from the menu bar,
and clicking "Save Transcript". You can save it either to an HTML document or to
a plain text file.
<h2>HTML Document</h2>
When saved to an HTML document, the chat dialog is written as compliant XHTML
source code, keeping all of the chat colors intact.
<h2>Text Document</h2>
When saved to a text document, the chat dialog is saved in plain text format,
without any of the colors and special formatting.
<h1>Automatic Logging</h1>
In the <a href="general.html">General</a> tab of the Preferences window, there's
an option to automatically save all transcripts. To review the saved logs, look
in your profile directory. See <a href="profile.html">User Profiles</a> for more
information.
</body>
</html>

65
docs/usage.html Normal file
View File

@ -0,0 +1,65 @@
<html>
<head>
<title>Using PCCC</title>
</head>
<body bgcolor="#FFFFEE" link="#0000FF" vlink="#990099" alink="#009900" text="#000000">
<basefont face="Arial" size="3" color="#000000">
<h1>Getting Started with PCCC</h1>
When you start up the Perl CyanChat Client, you will be presented with the
Main Window, where a message by "<font color="#FF0000">ChatClient</font>" is
already visible on screen, welcoming you to PCCC.<p>
To <b>connect</b> to the CyanChat room, select "Connection" from the menu bar,
and choose "Connect". This will attempt to connect you to the CyanChat server.
Once connected, you will see a lot of "lobby messages" sent by
"<font color="#009900">ChatServer</font>", and moments later the Who List will
display the list of users logged into the chat room (if there are any logged in).
<h1>Chat Presence</h1>
To <b>enter the chat</b>, type in a nickname for yourself in the "Name:" box, and
then press the "Join Chat" button. Note that your nickname <u>must</u> be less than
20 characters long, and <u>cannot</u> contain a caret (^), pipe symbol ("|"), or a
comma. If your name is accepted by the server, you will "link in" to the room. Otherwise,
<font color="#009900">ChatServer</font> will tell you that your nick was invalid.<p>
When a user <b>links in</b> to the chat room (in other words, enters the room), a message
will display similar to the following:
<blockquote>
\\\\\[Nick] &lt;links in from somewhere on the internet Age&gt;////
</blockquote>
When a user <b>links out</b> of the chat room (in other words, exiting the room by
clicking the "Exit Chat" button), a message will display similar to the following:
<blockquote>
/////[Nick] &lt;links safely back to their home Age&gt;\\\\\
</blockquote>
Finally, when a user <b>disconnects</b> from the chat room, the following message
is displayed:
<blockquote>
/////[Nick] &lt;mistakenly used an unsafe linking book without a maintainer's suit
*ZZZZZWHAP*&gt;\\\\\
</blockquote>
All users in the chat room also have a unique <b>address</b> assigned to them. This
is a mangled up form of their IP address, so multiple nicks from the same computer
will probably have the same address. To see a user's address, right-click their name
in the Who List.
<h1>Standard Messaging</h1>
To send a message to the chat room, simply type it into the entry box at the top of the
Main Window and press the Return key. Note that you must be logged in before you can
send messages!<p>
See <a href="pm.html">Private Messaging</a> and <a href="action.html">Action Messages</a>
for information about different types of messaging.
</body>
</html>

696
lib/Net/CyanChat.pm Normal file
View File

@ -0,0 +1,696 @@
package Net::CyanChat;
use strict;
use warnings;
use IO::Socket;
use IO::Select;
our $VERSION = '0.06';
sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
my $self = {
host => 'cho.cyan.com', # Default CC Host
port => 1812, # Default CC Port (1813=debugging)
debug => 0, # Debug Mode
proto => 1, # Use Protocol 1 (not 0)
sock => undef, # Socket Object
select => undef, # Select Object
pinged => 0, # Last Ping Time
refresh => 60, # Ping Rate = 60 Seconds
nickname => '', # Our Nickname
handlers => {}, # Handlers
connected => 0, # Are We Connected?
accepted => 0, # Logged in?
who => {}, # Who List
ignored => {}, # Ignored List
nicks => {}, # Nickname Lookup Table
@_,
};
# Protocol support numbers: 0 and 1.
if ($self->{proto} < 0 || $self->{proto} > 1) {
die "Unsupported protocol version: must be 0 or 1!";
}
bless ($self,$class);
return $self;
}
sub version {
my ($self) = @_;
return $VERSION;
}
sub debug {
my ($self,$msg) = @_;
return unless $self->{debug} == 1;
print "Net::CyanChat::debug // $msg\n";
}
sub send {
my ($self,$data) = @_;
# Send the data.
if (defined $self->{sock}) {
$self->_event ('Packet', 'outgoing', $data);
# Send true CrLf
$self->{sock}->send ("$data\x0d\x0a") or do {
# We've been disconnected!
$self->{sock}->close();
$self->{sock} = undef;
$self->{select} = undef;
$self->{connected} = 0;
$self->{nick} = '';
$self->{pinged} = 0;
$self->{who} = {};
$self->{nicks} = {};
$self->_event ('Disconnected');
};
}
else {
warn "Could not send \"$data\" to CyanChat: connection not established!";
}
}
sub setHandler {
my ($self,$event,$code) = @_;
# Set this handler.
$self->{handlers}->{$event} = $code;
}
sub connect {
my ($self) = @_;
# Connect to CyanChat.
$self->{sock} = new IO::Socket::INET (
PeerAddr => $self->{host},
PeerPort => $self->{port},
Proto => 'tcp',
);
# Error?
if (!defined $self->{sock}) {
$self->_event ('Error', "00|Connection Error", "Net::CyanChat Connection Error: $!");
}
# Create a select object.
$self->{select} = IO::Select->new ($self->{sock});
# Send that we're ready.
$self->send ("40|$self->{proto}");
}
sub start {
my ($self) = @_;
while (1) {
$self->do_one_loop or last;
}
}
sub login {
my ($self,$nick) = @_;
if (length $nick > 0) {
# Sign in.
$self->send ("10|$nick");
$self->{nickname} = $nick;
return 1;
}
return 0;
}
sub logout {
my ($self) = @_;
return 0 unless length $self->{nickname} > 0;
$self->{nickname} = '';
$self->{accepted} = 0;
$self->send ("15");
return 1;
}
sub sendMessage {
my ($self,$msg) = @_;
# Send the message.
return 0 unless length $msg > 0;
$self->send ("30|^1$msg");
}
sub sendPrivate {
my ($self,$to,$msg) = @_;
return unless (length $to > 0 && length $msg > 0);
# Get the user's full nick.
my $nick = $self->{nicks}->{$to};
# Send this user a message.
$self->send ("20|$nick|^1$msg");
}
sub getBuddies {
my ($self) = @_;
# Return the buddylist.
return $self->{who};
}
sub getFullName {
my ($self,$who) = @_;
# Return this user's full name.
return $self->{full}->{$who} or 0;
}
sub getAddress {
my ($self,$who) = @_;
# Return this user's address.
return $self->{who}->{$who} or 0;
}
sub protocol {
my ($self) = @_;
return $self->{proto};
}
sub nick {
my ($self) = @_;
return $self->{nickname};
}
sub ignore {
my ($self,$who) = @_;
# Ignore this user.
return unless length $who > 0;
$self->{ignored}->{$who} = 1;
$self->send ("70|$who");
}
sub unignore {
my ($self,$who) = @_;
# Unignore this user.
return unless length $who > 0;
delete $self->{ignored}->{$who};
$self->send ("70|$who");
}
sub authenticate {
my ($self,$password) = @_;
# Authenticate with a CC password.
$self->send ("50|$password");
}
sub promote {
my ($self,$user) = @_;
# Promote this user to Special Guest.
$self->send ("60|$user|4");
}
sub demote {
my ($self,$user) = @_;
# Demote this user.
$self->send ("60|$user|0");
}
sub _event {
my ($self,$event,@data) = @_;
return unless exists $self->{handlers}->{$event};
&{$self->{handlers}->{$event}} ($self,@data);
}
sub do_one_loop {
my ($self) = @_;
# Time to ping again?
if ($self->{pinged} > 0) {
# If connected...
if ($self->{connected} == 1) {
# If logged in...
if ($self->{accepted} == 1) {
# If refresh time has passed...
if (time() - $self->{pinged} >= $self->{refresh}) {
# To ping, send a private message to nobody.
$self->send ("20||^1ping");
$self->{pinged} = time();
}
}
}
}
return unless defined $self->{select};
# Loop with the server.
my @ready = $self->{select}->can_read(.001);
return unless(@ready);
foreach my $socket (@ready) {
my $resp;
$self->{sock}->recv ($resp,2048,0);
my @in = split(/\n/, $resp);
# The server has sent us a message!
foreach my $said (@in) {
$said =~ s/\r//ig;
my ($command,@args) = split(/\|/, $said);
# The first message received?
if ($self->{connected} == 0) {
$self->{connected} = 1;
$self->_event ('Connected');
$self->{pinged} = time();
}
$self->_event ('Packet', 'incoming', $said);
# Go through the commands.
if ($command == 10) {
# 10 = Name is invalid.
$self->_event ('Error', 10, "Your name is invalid.");
}
elsif ($command == 11) {
# 11 = Name accepted.
$self->{accepted} = 1;
$self->_event ('Name_Accepted');
}
elsif ($command == 21) {
# 21 = Private Message
my $type = 0;
my ($level) = $args[0] =~ /^(\d)/;
$type = $args[1] =~ /^\^(\d)/;
$args[0] =~ s/^(\d)//ig;
$args[1] =~ s/^\^(\d)//ig;
# Get the sender's nick and address.
my ($nick,$addr) = split(/\,/, $args[0], 2);
# Skip ignored users.
next if exists $self->{ignored}->{$nick};
shift (@args);
my $text = join ('|',@args);
# Call the event.
$self->_event ('Private', $nick, $level, $addr, $text);
}
elsif ($command == 31) {
# 31 = Public Message.
my $type = 1;
my ($level) = $args[0] =~ /^(\d)/;
($type) = $args[1] =~ /^\^(\d)/;
$args[0] =~ s/^(\d)//i;
$args[1] =~ s/^\^(\d)//i;
# Get the sender's nick and address.
my ($nick,$addr) = split(/\,/, $args[0], 2);
# Skip ignored users.
next if exists $self->{ignored}->{$nick};
# Chop off spaces.
$args[1] =~ s/^\s//ig;
# Shift off data.
shift (@args); # nickname
my $text = join ('|',@args);
# User has entered the room.
if ($type == 2) {
# Call the event.
$self->_event ('Chat_Buddy_In', $nick, $level, $addr, $text);
}
elsif ($type == 3) {
# Call the event.
$self->_event ('Chat_Buddy_Out', $nick, $level, $addr, $text);
}
else {
# Normal message.
$self->_event ('Message', $nick, $level, $addr, $text);
}
}
elsif ($command == 35) {
# 35 = Who List Update.
my %this = ();
foreach my $user (@args) {
my ($nick,$addr) = split(/\,/, $user, 2);
my $fullNick = $nick;
# Get data about this user.
my ($level) = $nick =~ /^(\d)/;
$nick =~ s/^(\d)//i;
# User is online.
$self->{who}->{$nick} = $addr;
$this{$nick} = 1;
# Call the event.
$self->{nicks}->{$nick} = $fullNick;
$self->_event ('Chat_Buddy_Here', $nick, $level, $addr);
}
# New event: WhoList = sends the entire Who List at once.
$self->_event ('WhoList', @args);
# See if anybody should be dropped.
foreach my $who (keys %{$self->{who}}) {
if (!exists $this{$who}) {
# Buddy's gone.
delete $self->{who}->{$who};
}
}
}
elsif ($command == 40) {
# 40 = Server welcome message (the "pong" of 40 from the client).
$self->_event ('Welcome', $args[0]);
}
elsif ($command == 70) {
# 70 = Ignored/Unignored a user.
my $user = $args[0];
if (exists $self->{ignored}->{$user}) {
delete $self->{ignored}->{$user};
$self->_event ('Ignored', 0, $user);
}
else {
$self->{ignored}->{$user} = 1;
$self->_event ('Ignored', 1, $user);
}
}
else {
$self->debug ("Unknown event code from server: $command|"
. join ('|', @args) );
}
}
}
return 1;
}
1;
__END__
=head1 NAME
Net::CyanChat - Perl interface for connecting to Cyan Worlds' chat room.
=head1 SYNOPSIS
use Net::CyanChat;
my $cyan = new Net::CyanChat (
host => 'cho.cyan.com', # default
port => 1812, # main port--1813 is for testing
proto => 1, # use protocol 1.0
refresh => 60, # ping rate (default)
);
# Set up handlers.
$cyan->setHandler (foo => \&bar);
# Connect
$cyan->start();
=head1 DESCRIPTION
Net::CyanChat is a Perl module for object-oriented connections to Cyan Worlds, Inc.'s
chat room.
=head1 NOTE TO DEVELOPERS
Cyan Chat regulars really HATE bots! Recommended usage of this module is for developing
your own client, or a silent logging bot. Auto-Shorah (greeting users who enter the room)
is strongly advised against.
=head1 METHODS
=head2 new (ARGUMENTS)
Constructor for a new CyanChat object. Pass in any arguments you need. Some standard arguments
are: host (defaults to cho.cyan.com), port (defaults to 1812), proto (protocol version--0 or 1--defaults
to 1), debug, or refresh.
Returns a CyanChat object.
=head2 version
Returns the version number.
=head2 debug (MESSAGE)
Called by the module itself for debug messages.
=head2 send (DATA)
Send raw data to the CyanChat server.
=head2 setHandler (EVENT_CODE => CODEREF)
Set up a handler for the CyanChat connection. See below for a list of handlers.
=head2 connect
Connect to CyanChat's server.
=head2 start
Start a loop of do_one_loop's.
=head2 do_one_loop
Perform a single loop on the server.
=head2 login (NICK)
After receiving a "Connected" event from the server, it is okay to log in now. NICK
should be no more than 20 characters and cannot contain a pipe symbol "|".
This method can be called even after you have logged in once, for example if you want
to change your nickname without logging out and then back in.
=head2 logout
Log out of CyanChat. Must be logged in first.
=head2 sendMessage (MESSAGE)
Broadcast a message publicly to the chat room. Can only be called after you have logged
in through $cyan->login.
=head2 sendPrivate (TO, MESSAGE)
Send a private message to recipient TO. Must be logged in first.
=head2 getBuddies
Returns a hashref containing each buddy's username as the keys and their addresses as the values.
=head2 getFullName (NICK)
Returns the full name of passed in NICK. If NICK is not in the room, returns 0. FullName is the
name that CyanChat recognizes NICK by (including their auth code, i.e. "0username" for normal
users and "1username" for Cyan staff).
=head2 getAddress (NICK)
Returns the address to NICK. This is not their IP address; CyanChat encrypts their IP into this
address, and it is basicly a unique identifier for a connection. Multiple users logged on from the
same IP address will have the same chat address. Ignoring users will ignore them by address.
=head2 protocol
Returns the protocol version you are using. Will return 0 or 1.
=head2 ignore (USER), unignore (USER)
Ignore and unignore a username. When a user is ignored, the Message and Private events will not
be called when they send a message.
=head2 nick
Returns the currently signed in nickname of the CyanChat object.
=head1 ADVANCED METHODS
B<WARNING:> These methods are very dangerous to use if you don't know what you're doing.
Don't call authenticate() unless you know for sure what the CyanChat admin password is,
and don't call promote() or demote() unless you are already authenticated as a CyanChat
staff user.
Calling the authenticate() command with the wrong password will most likely get you
banned from CyanChat, and calling promote() or demote() without being an admin user
will probably have the same effect.
In other words, B<don't use these methods unless you know what you're doing!>
=head2 authenticate (PASSWORD)
Authenticate your connection as a Cyan Worlds staff member. Call this method before
entering the chat room.
=head2 promote (USER)
Promote USER to a Special Guest.
=head2 demote (USER)
Demote USER to a normal user level.
=head1 HANDLERS
=head2 Connected (CYANCHAT)
Called when a connection has been established, and the server recognizes your client's
presence. At this point, you can call CYANCHAT->login (NICK) to log into the chat room.
=head2 Disconnected (CYANCHAT)
Called when a disconnect has been detected.
=head2 Welcome (CYANCHAT, MESSAGE)
Called after the server recognizes your client (almost simultaneously to Connected).
MESSAGE are messages that the CyanChat server sends--mostly just includes a list of the
chat room's rules.
=head2 Message (CYANCHAT, NICK, LEVEL, ADDRESS, MESSAGE)
Called when a user sends a message publicly in chat. NICK is their nickname, LEVEL is their
auth level (0 = normal, 1 = Cyan employee, etc. - see below for full list). ADDRESS is their
chat address, and MESSAGE is their message.
=head2 Private (CYANCHAT, NICK, LEVEL, ADDRESS, MESSAGE)
Called when a user sends a private message to your client. All the arguments are the same
as the Message handler.
=head2 Ignored (CYANCHAT, IGNORE, NICK)
Called when a user has been ignored or unignored. IGNORE will be 1 (ignoring) or
0 (unignoring). NICK is their nickname.
=head2 Chat_Buddy_In (CYANCHAT, NICK, LEVEL, ADDRESS, MESSAGE)
Called when a buddy enters the chat room. NICK, LEVEL, and ADDRESS are the same as in the
Message and Private handlers. MESSAGE is their join message (i.e. "<links in from comcast.net age>")
=head2 Chat_Buddy_Out (CYANCHAT, NICK, LEVEL, ADDRESS, MESSAGE)
Called when a buddy exits. MESSAGE is their exit message (i.e. "<links safely back to their home Age>"
for normal log out, or "<mistakenly used an unsafe Linking Book without a maintainer's suit>" for
disconnected).
=head2 Chat_Buddy_Here (CYANCHAT, NICK, LEVEL, ADDRESS)
Called for each member currently in the room. Each time the Who List updates, this handler is called
for each buddy in the room.
=head2 WhoList (CYANCHAT, USERS)
This handler is called whenever a "35" (WhoList) event is received from the server. USERS is an array
of the raw user data the server sent. The array is full of elements of the format:
#username,address
Where # is the auth level. Unlike Chat_Buddy_Here, your program needs to loop and parse out info
from each of the users.
=head2 Name_Accepted (CYANCHAT)
The CyanChat server has accepted your name.
=head2 Error (CYANCHAT, CODE, STRING)
Handles errors issued by CyanChat. CODE is the exact server code issued that caused the error.
STRING is either an English description or the exact text the server sent.
=head1 CYAN CHAT RULES
The CyanChat server strictly enforces these rules:
Be respectful and sensitive to others (please, no platform wars).
Keep it "G" rated (family viewing), both in language and content.
And HAVE FUN!
Termination of use can happen without warning!
=head1 CYAN CHAT AUTH LEVELS
Auth levels (received as LEVEL to most handlers, or prefixed onto a user's FullName) are as follows:
0 is for regular chat user (should be in white)
1 is for Cyan Worlds employee (should be in cyan)
2 is for CyanChat Server message (should be in green)
4 is for special guest (should be in gold)
Any other number is probably a client error message (and is in red)
=head1 CHANGE LOG
Version 0.05
- Fixed the end-of-line characters, it now sends a true CrLf.
- Added the WhoList handler.
- Added the authenticate(), promote(), and demote() methods.
Version 0.04
- The enter/exit chat messages now go by the tag number (like it's supposed to),
not by the contained text.
- Messages can contain pipes in them and be read okay through the module.
- Added a "ping" function. Apparently Cho will disconnect clients who don't do
anything in 5 minutes. The "ping" function also helps detect disconnects!
- The Disconnected handler has been added to detect disconnects.
Version 0.03
- Bug fix: the $level received to most handlers used to be 1 (cyan staff) even
though it should've been 0 (or any other number), so this has been fixed.
Version 0.01
- Initial release.
- Fully supports both protocols 0 and 1 of CyanChat.
=head1 SEE ALSO
Net::CyanChat::Server
CyanChat Protocol Documentation: http://cho.cyan.com/chat/programmers.html
=head1 AUTHOR
Cerone J. Kirsle <cjk "@" aichaos.com>
=head1 COPYRIGHT AND LICENSE
Net::CyanChat - Perl interface to CyanChat.
Copyright (C) 2005 Cerone J. Kirsle
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
=cut

700
lib/Net/CyanChat.pm~ Normal file
View File

@ -0,0 +1,700 @@
package Net::CyanChat;
use strict;
use warnings;
use IO::Socket;
use IO::Select;
our $VERSION = '0.06';
sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
my $self = {
host => 'cho.cyan.com', # Default CC Host
port => 1812, # Default CC Port (1813=debugging)
debug => 0, # Debug Mode
proto => 1, # Use Protocol 1 (not 0)
sock => undef, # Socket Object
select => undef, # Select Object
pinged => 0, # Last Ping Time
refresh => 60, # Ping Rate = 60 Seconds
nickname => '', # Our Nickname
handlers => {}, # Handlers
connected => 0, # Are We Connected?
accepted => 0, # Logged in?
who => {}, # Who List
ignored => {}, # Ignored List
nicks => {}, # Nickname Lookup Table
@_,
};
# Protocol support numbers: 0 and 1.
if ($self->{proto} < 0 || $self->{proto} > 1) {
die "Unsupported protocol version: must be 0 or 1!";
}
bless ($self,$class);
return $self;
}
sub version {
my ($self) = @_;
return $VERSION;
}
sub debug {
my ($self,$msg) = @_;
return unless $self->{debug} == 1;
print "Net::CyanChat::debug // $msg\n";
}
sub send {
my ($self,$data) = @_;
# Send the data.
if (defined $self->{sock}) {
$self->_event ('Packet', 'outgoing', $data);
# Send true CrLf
$self->{sock}->send ("$data\x0d\x0a") or do {
# We've been disconnected!
$self->{sock}->close();
$self->{sock} = undef;
$self->{select} = undef;
$self->{connected} = 0;
$self->{nick} = '';
$self->{pinged} = 0;
$self->{who} = {};
$self->{nicks} = {};
$self->_event ('Disconnected');
};
}
else {
warn "Could not send \"$data\" to CyanChat: connection not established!";
}
}
sub setHandler {
my ($self,$event,$code) = @_;
# Set this handler.
$self->{handlers}->{$event} = $code;
}
sub connect {
my ($self) = @_;
# Connect to CyanChat.
$self->{sock} = new IO::Socket::INET (
PeerAddr => $self->{host},
PeerPort => $self->{port},
Proto => 'tcp',
);
# Error?
if (!defined $self->{sock}) {
$self->_event ('Error', "00|Connection Error", "Net::CyanChat Connection Error: $!");
}
# Create a select object.
$self->{select} = IO::Select->new ($self->{sock});
# Send that we're ready.
$self->send ("40|$self->{proto}");
}
sub start {
my ($self) = @_;
while (1) {
$self->do_one_loop or last;
}
}
sub login {
my ($self,$nick) = @_;
if (length $nick > 0) {
# Sign in.
$self->send ("10|$nick");
$self->{nickname} = $nick;
return 1;
}
return 0;
}
sub logout {
my ($self) = @_;
return 0 unless length $self->{nickname} > 0;
$self->{nickname} = '';
$self->{accepted} = 0;
$self->send ("15");
return 1;
}
sub sendMessage {
my ($self,$msg) = @_;
# Send the message.
return 0 unless length $msg > 0;
$self->send ("30|^1$msg");
}
sub sendPrivate {
my ($self,$to,$msg) = @_;
return unless (length $to > 0 && length $msg > 0);
# Get the user's full nick.
my $nick = $self->{nicks}->{$to};
# Send this user a message.
$self->send ("20|$nick|^1$msg");
}
sub getBuddies {
my ($self) = @_;
# Return the buddylist.
return $self->{who};
}
sub getFullName {
my ($self,$who) = @_;
# Return this user's full name.
return $self->{full}->{$who} or 0;
}
sub getAddress {
my ($self,$who) = @_;
# Return this user's address.
return $self->{who}->{$who} or 0;
}
sub protocol {
my ($self) = @_;
return $self->{proto};
}
sub nick {
my ($self) = @_;
return $self->{nickname};
}
sub ignore {
my ($self,$who) = @_;
# Ignore this user.
return unless length $who > 0;
$self->{ignored}->{$who} = 1;
$self->send ("70|$who");
}
sub unignore {
my ($self,$who) = @_;
# Unignore this user.
return unless length $who > 0;
delete $self->{ignored}->{$who};
$self->send ("70|$who");
}
sub authenticate {
my ($self,$password) = @_;
# Authenticate with a CC password.
$self->send ("50|$password");
}
sub promote {
my ($self,$user) = @_;
# Promote this user to Special Guest.
$self->send ("60|$user|4");
}
sub demote {
my ($self,$user) = @_;
# Demote this user.
$self->send ("60|$user|0");
}
sub _event {
my ($self,$event,@data) = @_;
print "_event: $event, @data\n";
return unless exists $self->{handlers}->{$event};
print "calling event for $event\n";
&{$self->{handlers}->{$event}} ($self,@data);
}
sub do_one_loop {
my ($self) = @_;
# Time to ping again?
if ($self->{pinged} > 0) {
# If connected...
if ($self->{connected} == 1) {
# If logged in...
if ($self->{accepted} == 1) {
# If refresh time has passed...
if (time() - $self->{pinged} >= $self->{refresh}) {
# To ping, send a private message to nobody.
$self->send ("20||^1ping");
$self->{pinged} = time();
}
}
}
}
return unless defined $self->{select};
# Loop with the server.
my @ready = $self->{select}->can_read(.001);
return unless(@ready);
foreach my $socket (@ready) {
my $resp;
$self->{sock}->recv ($resp,2048,0);
my @in = split(/\n/, $resp);
# The server has sent us a message!
foreach my $said (@in) {
$said =~ s/\r//ig;
my ($command,@args) = split(/\|/, $said);
# The first message received?
if ($self->{connected} == 0) {
$self->{connected} = 1;
$self->_event ('Connected');
$self->{pinged} = time();
}
$self->_event ('Packet', 'incoming', $said);
# Go through the commands.
if ($command == 10) {
# 10 = Name is invalid.
$self->_event ('Error', 10, "Your name is invalid.");
}
elsif ($command == 11) {
# 11 = Name accepted.
$self->{accepted} = 1;
$self->_event ('Name_Accepted');
}
elsif ($command == 21) {
# 21 = Private Message
my $type = 0;
my ($level) = $args[0] =~ /^(\d)/;
$type = $args[1] =~ /^\^(\d)/;
$args[0] =~ s/^(\d)//ig;
$args[1] =~ s/^\^(\d)//ig;
# Get the sender's nick and address.
my ($nick,$addr) = split(/\,/, $args[0], 2);
# Skip ignored users.
next if exists $self->{ignored}->{$nick};
shift (@args);
my $text = join ('|',@args);
# Call the event.
$self->_event ('Private', $nick, $level, $addr, $text);
}
elsif ($command == 31) {
# 31 = Public Message.
my $type = 1;
my ($level) = $args[0] =~ /^(\d)/;
($type) = $args[1] =~ /^\^(\d)/;
$args[0] =~ s/^(\d)//i;
$args[1] =~ s/^\^(\d)//i;
# Get the sender's nick and address.
my ($nick,$addr) = split(/\,/, $args[0], 2);
# Skip ignored users.
next if exists $self->{ignored}->{$nick};
# Chop off spaces.
$args[1] =~ s/^\s//ig;
# Shift off data.
shift (@args); # nickname
my $text = join ('|',@args);
# User has entered the room.
if ($type == 2) {
# Call the event.
$self->_event ('Chat_Buddy_In', $nick, $level, $addr, $text);
}
elsif ($type == 3) {
# Call the event.
$self->_event ('Chat_Buddy_Out', $nick, $level, $addr, $text);
}
else {
# Normal message.
$self->_event ('Message', $nick, $level, $addr, $text);
}
}
elsif ($command == 35) {
# 35 = Who List Update.
my %this = ();
foreach my $user (@args) {
my ($nick,$addr) = split(/\,/, $user, 2);
my $fullNick = $nick;
# Get data about this user.
my ($level) = $nick =~ /^(\d)/;
$nick =~ s/^(\d)//i;
# User is online.
$self->{who}->{$nick} = $addr;
$this{$nick} = 1;
# Call the event.
$self->{nicks}->{$nick} = $fullNick;
$self->_event ('Chat_Buddy_Here', $nick, $level, $addr);
}
# New event: WhoList = sends the entire Who List at once.
$self->_event ('WhoList', @args);
# See if anybody should be dropped.
foreach my $who (keys %{$self->{who}}) {
if (!exists $this{$who}) {
# Buddy's gone.
delete $self->{who}->{$who};
}
}
}
elsif ($command == 40) {
print "^^^ got 40 ($args[0])\n";
# 40 = Server welcome message (the "pong" of 40 from the client).
$self->_event ('Welcome', $args[0]);
}
elsif ($command == 70) {
# 70 = Ignored/Unignored a user.
my $user = $args[0];
if (exists $self->{ignored}->{$user}) {
delete $self->{ignored}->{$user};
$self->_event ('Ignored', 0, $user);
}
else {
$self->{ignored}->{$user} = 1;
$self->_event ('Ignored', 1, $user);
}
}
else {
$self->debug ("Unknown event code from server: $command|"
. join ('|', @args) );
}
}
}
return 1;
}
1;
__END__
=head1 NAME
Net::CyanChat - Perl interface for connecting to Cyan Worlds' chat room.
=head1 SYNOPSIS
use Net::CyanChat;
my $cyan = new Net::CyanChat (
host => 'cho.cyan.com', # default
port => 1812, # main port--1813 is for testing
proto => 1, # use protocol 1.0
refresh => 60, # ping rate (default)
);
# Set up handlers.
$cyan->setHandler (foo => \&bar);
# Connect
$cyan->start();
=head1 DESCRIPTION
Net::CyanChat is a Perl module for object-oriented connections to Cyan Worlds, Inc.'s
chat room.
=head1 NOTE TO DEVELOPERS
Cyan Chat regulars really HATE bots! Recommended usage of this module is for developing
your own client, or a silent logging bot. Auto-Shorah (greeting users who enter the room)
is strongly advised against.
=head1 METHODS
=head2 new (ARGUMENTS)
Constructor for a new CyanChat object. Pass in any arguments you need. Some standard arguments
are: host (defaults to cho.cyan.com), port (defaults to 1812), proto (protocol version--0 or 1--defaults
to 1), debug, or refresh.
Returns a CyanChat object.
=head2 version
Returns the version number.
=head2 debug (MESSAGE)
Called by the module itself for debug messages.
=head2 send (DATA)
Send raw data to the CyanChat server.
=head2 setHandler (EVENT_CODE => CODEREF)
Set up a handler for the CyanChat connection. See below for a list of handlers.
=head2 connect
Connect to CyanChat's server.
=head2 start
Start a loop of do_one_loop's.
=head2 do_one_loop
Perform a single loop on the server.
=head2 login (NICK)
After receiving a "Connected" event from the server, it is okay to log in now. NICK
should be no more than 20 characters and cannot contain a pipe symbol "|".
This method can be called even after you have logged in once, for example if you want
to change your nickname without logging out and then back in.
=head2 logout
Log out of CyanChat. Must be logged in first.
=head2 sendMessage (MESSAGE)
Broadcast a message publicly to the chat room. Can only be called after you have logged
in through $cyan->login.
=head2 sendPrivate (TO, MESSAGE)
Send a private message to recipient TO. Must be logged in first.
=head2 getBuddies
Returns a hashref containing each buddy's username as the keys and their addresses as the values.
=head2 getFullName (NICK)
Returns the full name of passed in NICK. If NICK is not in the room, returns 0. FullName is the
name that CyanChat recognizes NICK by (including their auth code, i.e. "0username" for normal
users and "1username" for Cyan staff).
=head2 getAddress (NICK)
Returns the address to NICK. This is not their IP address; CyanChat encrypts their IP into this
address, and it is basicly a unique identifier for a connection. Multiple users logged on from the
same IP address will have the same chat address. Ignoring users will ignore them by address.
=head2 protocol
Returns the protocol version you are using. Will return 0 or 1.
=head2 ignore (USER), unignore (USER)
Ignore and unignore a username. When a user is ignored, the Message and Private events will not
be called when they send a message.
=head2 nick
Returns the currently signed in nickname of the CyanChat object.
=head1 ADVANCED METHODS
B<WARNING:> These methods are very dangerous to use if you don't know what you're doing.
Don't call authenticate() unless you know for sure what the CyanChat admin password is,
and don't call promote() or demote() unless you are already authenticated as a CyanChat
staff user.
Calling the authenticate() command with the wrong password will most likely get you
banned from CyanChat, and calling promote() or demote() without being an admin user
will probably have the same effect.
In other words, B<don't use these methods unless you know what you're doing!>
=head2 authenticate (PASSWORD)
Authenticate your connection as a Cyan Worlds staff member. Call this method before
entering the chat room.
=head2 promote (USER)
Promote USER to a Special Guest.
=head2 demote (USER)
Demote USER to a normal user level.
=head1 HANDLERS
=head2 Connected (CYANCHAT)
Called when a connection has been established, and the server recognizes your client's
presence. At this point, you can call CYANCHAT->login (NICK) to log into the chat room.
=head2 Disconnected (CYANCHAT)
Called when a disconnect has been detected.
=head2 Welcome (CYANCHAT, MESSAGE)
Called after the server recognizes your client (almost simultaneously to Connected).
MESSAGE are messages that the CyanChat server sends--mostly just includes a list of the
chat room's rules.
=head2 Message (CYANCHAT, NICK, LEVEL, ADDRESS, MESSAGE)
Called when a user sends a message publicly in chat. NICK is their nickname, LEVEL is their
auth level (0 = normal, 1 = Cyan employee, etc. - see below for full list). ADDRESS is their
chat address, and MESSAGE is their message.
=head2 Private (CYANCHAT, NICK, LEVEL, ADDRESS, MESSAGE)
Called when a user sends a private message to your client. All the arguments are the same
as the Message handler.
=head2 Ignored (CYANCHAT, IGNORE, NICK)
Called when a user has been ignored or unignored. IGNORE will be 1 (ignoring) or
0 (unignoring). NICK is their nickname.
=head2 Chat_Buddy_In (CYANCHAT, NICK, LEVEL, ADDRESS, MESSAGE)
Called when a buddy enters the chat room. NICK, LEVEL, and ADDRESS are the same as in the
Message and Private handlers. MESSAGE is their join message (i.e. "<links in from comcast.net age>")
=head2 Chat_Buddy_Out (CYANCHAT, NICK, LEVEL, ADDRESS, MESSAGE)
Called when a buddy exits. MESSAGE is their exit message (i.e. "<links safely back to their home Age>"
for normal log out, or "<mistakenly used an unsafe Linking Book without a maintainer's suit>" for
disconnected).
=head2 Chat_Buddy_Here (CYANCHAT, NICK, LEVEL, ADDRESS)
Called for each member currently in the room. Each time the Who List updates, this handler is called
for each buddy in the room.
=head2 WhoList (CYANCHAT, USERS)
This handler is called whenever a "35" (WhoList) event is received from the server. USERS is an array
of the raw user data the server sent. The array is full of elements of the format:
#username,address
Where # is the auth level. Unlike Chat_Buddy_Here, your program needs to loop and parse out info
from each of the users.
=head2 Name_Accepted (CYANCHAT)
The CyanChat server has accepted your name.
=head2 Error (CYANCHAT, CODE, STRING)
Handles errors issued by CyanChat. CODE is the exact server code issued that caused the error.
STRING is either an English description or the exact text the server sent.
=head1 CYAN CHAT RULES
The CyanChat server strictly enforces these rules:
Be respectful and sensitive to others (please, no platform wars).
Keep it "G" rated (family viewing), both in language and content.
And HAVE FUN!
Termination of use can happen without warning!
=head1 CYAN CHAT AUTH LEVELS
Auth levels (received as LEVEL to most handlers, or prefixed onto a user's FullName) are as follows:
0 is for regular chat user (should be in white)
1 is for Cyan Worlds employee (should be in cyan)
2 is for CyanChat Server message (should be in green)
4 is for special guest (should be in gold)
Any other number is probably a client error message (and is in red)
=head1 CHANGE LOG
Version 0.05
- Fixed the end-of-line characters, it now sends a true CrLf.
- Added the WhoList handler.
- Added the authenticate(), promote(), and demote() methods.
Version 0.04
- The enter/exit chat messages now go by the tag number (like it's supposed to),
not by the contained text.
- Messages can contain pipes in them and be read okay through the module.
- Added a "ping" function. Apparently Cho will disconnect clients who don't do
anything in 5 minutes. The "ping" function also helps detect disconnects!
- The Disconnected handler has been added to detect disconnects.
Version 0.03
- Bug fix: the $level received to most handlers used to be 1 (cyan staff) even
though it should've been 0 (or any other number), so this has been fixed.
Version 0.01
- Initial release.
- Fully supports both protocols 0 and 1 of CyanChat.
=head1 SEE ALSO
Net::CyanChat::Server
CyanChat Protocol Documentation: http://cho.cyan.com/chat/programmers.html
=head1 AUTHOR
Cerone J. Kirsle <cjk "@" aichaos.com>
=head1 COPYRIGHT AND LICENSE
Net::CyanChat - Perl interface to CyanChat.
Copyright (C) 2005 Cerone J. Kirsle
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
=cut

792
lib/Tk/HyperText.pm Normal file
View File

@ -0,0 +1,792 @@
package Tk::HyperText;
use strict;
use warnings;
use base qw(Tk::Derived Tk::ROText);
use Data::Dumper;
our $VERSION = "0.03";
Construct Tk::Widget 'HyperText';
sub Populate {
my ($cw,$args) = @_;
# Strip out the arguments we want before passing them to ROText.
my $opts = {
# -autorender => re-render the entire HTML document on update
# (otherwise, only render incoming HTML)
rerender => delete $args->{'-rerender'} || 1,
# -linkcommand => a callback when a user clicks a link
linkcommand => delete $args->{'-linkcommand'} || sub {},
# -titlecommand => a callback when a page sets its title
titlecommand => delete $args->{'-titlecommand'} || sub {},
# -attributes => define default attributes for each tag
attributes => {
body => {
bgcolor => '#FFFFFF',
text => '#000000',
link => '#0000FF',
vlink => '#990099',
alink => '#FF0000',
},
font => {
family => 'Times New Roman',
size => 3, # HTML size; not point size.
color => '', # inherit from body
back => '', # inherit from body
},
},
};
# Copy attributes over.
if (exists $args->{'-attributes'}) {
my $attr = delete $args->{'-attributes'};
foreach my $tag (keys %{$attr}) {
foreach my $name (keys %{$attr->{$tag}}) {
$opts->{attributes}->{$tag}->{$name} = $attr->{$tag}->{$name};
}
}
}
# Pass the remaining arguments to our ROText parent.
$args->{'-foreground'} = $opts->{attributes}->{body}->{text};
$args->{'-background'} = $opts->{attributes}->{body}->{bgcolor};
$cw->SUPER::Populate($args);
# Reconfigure the ROText widget with our attributes.
$cw->SUPER::configure (
-font => [
-family => $opts->{attributes}->{font}->{family},
-size => $cw->_size ($opts->{attributes}->{font}->{size}),
],
);
$cw->{hypertext} = {
html => '', # holds HTML code
rerender => $opts->{rerender},
attributes => $opts->{attributes},
linkcommand => $opts->{linkcommand},
titlecommand => $opts->{titlecommand},
};
}
sub insert {
my $cw = shift;
my $pos = shift;
$pos = $cw->index ($pos);
my $text = shift;
# TODO: insert will only insert to the "end"
$cw->{hypertext}->{html} .= $text;
# If we're doing re-rendering, render the entire block of HTML at once.
if ($cw->{hypertext}->{rerender}) {
# Reset the title to blank.
&{$cw->{hypertext}->{titlecommand}} ($cw,"");
# Render the whole entire page.
$cw->SUPER::delete ("0.0","end");
$cw->render ($cw->{hypertext}->{html});
}
else {
# Just render this text.
$cw->render ($text);
}
}
sub delete {
my $cw = shift;
# TODO: delete just deletes everything
$cw->{hypertext}->{html} = '';
$cw->SUPER::delete ("0.0","end");
}
sub get {
my $cw = shift;
# TODO: get just gets everything.
return $cw->{hypertext}->{html};
}
sub clear {
my $cw = shift;
# Delete everything.
$cw->{hypertext}->{html} = '';
$cw->SUPER::delete ("0.0","end");
}
sub render {
my ($cw,$html) = @_;
# Make the HTML tags easier to find.
$html =~ s/</%TK::HYPERTEXT::START::TAG%/g;
$html =~ s/>/%TK::HYPERTEXT::END::TAG%/g;
# Split the tags apart.
my @parts = split(/%TK::HYPERTEXT/, $html);
# Make an array of default styles for this render.
my %default = (
bgcolor => $cw->{hypertext}->{body}->{bgcolor} || '#FFFFFF',
text => $cw->{hypertext}->{body}->{text} || '#000000',
link => $cw->{hypertext}->{body}->{link} || '#0000FF',
vlink => $cw->{hypertext}->{body}->{vlink} || '#990099',
alink => $cw->{hypertext}->{body}->{alink} || '#FF0000',
size => $cw->{hypertext}->{font}->{size} || 3,
font => $cw->{hypertext}->{font}->{family} || 'Times New Roman',
);
# Make an array of escape sequences.
my @escape = (
'&lt;' => '<',
'&gt;' => '>',
'&quot;' => '"',
'&apos;' => "'",
'&nbsp;' => ' ',
'&reg;' => chr(0x00ae), # registered trademark
'&copy;' => chr(0x00a9), # copyright sign
'&amp;' => '&',
);
# Reset the configuration of our ROText widget.
$cw->SUPER::configure (
-background => $default{bgcolor},
-foreground => $default{text},
-font => [
-family => $default{font},
-size => $cw->_size ($default{size}),
],
);
# Make an array of current styles for this render.
my %style = (
weight => 'normal', # or 'bold'
slant => 'roman', # or 'italic'
underline => 0, # or 1
overstrike => 0, # or 1
family => '',
size => '',
foreground => '',
background => '',
justify => 'left', # or 'center' or 'right'
offset => 0, # changes for <sup> and <sub>
margin => 0, # for <blockquote>s
titling => 0, # special--for title tags
title => '', # our page title
hyperlink => 0, # special--for hyperlinking
linktag => 0, # for hyperlinking
pre => 0, # special--for <pre>formatted text
);
# Stack the styles up.
my @stackFont = ();
my @stackColor = ();
my @stackBG = ();
my @stackSize = ();
my @stackAlign = ();
my @stackOffset = ();
my @stackMargin = ();
my @stackLinks = ();
# Set this to 1 when the first line of actual text has been written.
# Blocklevel elements like to know.
my $lineWritten = 0;
# Keep an array of hyperlinks.
my %hyperlinks = ();
# Start parsing through the HTML code.
foreach my $sector (@parts) {
# Is this a tag we're in?
if ($sector =~ /^::START::TAG%/i) {
$sector =~ s/^::START::TAG%//; # strip it
# Find out the name of this tag and its attributes.
my ($name,$attr) = split(/\s+/, $sector, 2);
$name = uc($name);
next unless defined $name && length $name;
# Handle the various types of tags.
if ($name eq "HTML" || $name eq "/HTML") { # <html>, </html>
# That was nice of the programmer.
}
elsif ($name eq "HEAD" || $name eq "/HEAD") { # <head>, </head>
# We don't need to do anything with this, either.
}
elsif ($name eq "TITLE") { # <title>
# They're about to tell us the title.
$style{titling} = 1;
}
elsif ($name eq "/TITLE") { # </title>
# Stop titling our page.
$style{titling} = 0;
# Call our title-setting callback.
&{$cw->{hypertext}->{titlecommand}} ($cw,$style{title});
}
elsif ($name eq "BODY") { # <body>
# Collect as much data as we can.
next unless defined $attr;
if ($attr =~ /bgcolor="(.+?)"/i) {
$cw->SUPER::configure (-background => $1);
$default{bgcolor} = $1;
}
if ($attr =~ /link="(.+?)"/i) {
$default{link} = $1;
}
if ($attr =~ /vlink="(.+?)"/i) {
$default{vlink} = $1;
}
if ($attr =~ /alink="(.+?)"/i) {
$default{alink} = $1;
}
if ($attr =~ /text="(.+?)"/i) {
$cw->SUPER::configure (-foreground => $1);
$default{text} = $1;
}
}
elsif ($name eq "/BODY") { # </body>
# Technically we shouldn't allow anymore HTML at this point,
# on account of the </body>, but let's not be too picky.
}
elsif ($name eq "BASEFONT") { # <basefont>
# Collect as much data as we can.
if ($attr =~ /face="(.+?)"/i) {
$default{font} = $1;
}
if ($attr =~ /size="(.+?)"/i) {
$default{size} = $1;
}
if ($attr =~ /color="(.+?)"/i) {
$default{text} = $1;
}
}
elsif ($name eq "FONT") { # <font>
# Collect info.
if ($attr =~ /face="(.+?)"/i) {
push (@stackFont,$1);
$style{family} = $1;
}
if ($attr =~ /color="(.+?)"/i) {
push (@stackColor,$1);
$style{foreground} = $1;
}
if ($attr =~ /back="(.+?)"/i) {
push (@stackBG,$1);
$style{background} = $1;
}
if ($attr =~ /size="(.+?)"/i) {
push (@stackSize,$1);
$style{size} = $1;
}
}
elsif ($name eq "/FONT") { # </font>
# Revert to the previous font stack.
pop(@stackFont);
pop(@stackColor);
pop(@stackBG);
pop(@stackSize);
$style{family} = $stackFont[-1] || '';
$style{foreground} = $stackColor[-1] || '';
$style{background} = $stackBG[-1] || '';
$style{size} = $stackSize[-1] || '';
}
elsif ($name eq "A") { # <a>
# Make sure this link has an href.
if ($attr =~ /href="(.+?)"/i) {
my $href = $1;
# Find the target.
my $target = "_self";
if ($attr =~ /target="(.+?)"/i) {
$target = $1;
}
# Create a unique hyperlink tag.
my $linktag = join ("-",$target,$href);
# Store this tag.
$hyperlinks{$linktag} = {
href => $href,
target => $target,
};
# Tell the tagger we're linking.
$style{hyperlink} = 1;
$style{linktag} = $linktag;
}
}
elsif ($name eq "/A") {
# We're not linking anymore.
$style{hyperlink} = 0;
$style{linktag} = '';
}
elsif ($name eq "BLOCKQUOTE") { # <blockquote>
$cw->SUPER::insert ('end',"\x0a\x0a") if $lineWritten;
$style{margin} += 25;
push (@stackMargin,$style{margin});
}
elsif ($name eq "/BLOCKQUOTE") { # </blockquote>
pop(@stackMargin);
$style{margin} = $stackMargin[-1] || 0;
$cw->SUPER::insert ('end',"\x0a\x0a");
$lineWritten = 0;
}
elsif ($name eq "P") { # <p>
$cw->SUPER::insert ('end',"\x0a\x0a") if $lineWritten;
}
elsif ($name eq "/P") { # </p>
$cw->SUPER::insert ('end',"\x0a\x0a");
$lineWritten = 0;
}
elsif ($name eq "BR") { # <br>
$cw->SUPER::insert ('end',"\x0a");
}
elsif ($name eq "PRE") { # <pre>
$cw->SUPER::insert ('end',"\x0a") if $lineWritten;
push (@stackFont,"Courier New");
$style{family} = "Courier New";
$style{pre} = 1;
}
elsif ($name eq "/PRE") { # </pre>
pop(@stackFont);
$style{family} = $stackFont[-1] || '';
$style{pre} = 0;
$cw->SUPER::insert ('end',"\x0a");
}
elsif ($name =~ /^(CODE|TT)$/) { # <code>, <tt>
push (@stackFont,"Courier New");
$style{family} = "Courier New";
}
elsif ($name =~ /^\/(CODE|TT)$/) { # </code>, </tt>
pop(@stackFont);
$style{family} = $stackFont[-1] || '';
}
elsif ($name =~ /^(CENTER|RIGHT|LEFT)$/) { # <center>, <right>, <left>
my $align = lc($name);
$cw->SUPER::insert ('end',"\x0a") if $lineWritten;
push (@stackAlign, $align);
$style{justify} = $align;
}
elsif ($name =~ /^\/(CENTER|RIGHT|LEFT)$/) { # </center>, </right>, </left>
pop(@stackAlign);
$style{justify} = $stackAlign[-1] || 'left';
$cw->SUPER::insert ('end',"\x0a");
}
elsif ($name =~ /^H(1|2|3|4|5|6|7)$/) { # <h1> - <h7>
my $size = $cw->_heading ($1);
$cw->SUPER::insert ('end',"\x0a\x0a") if $lineWritten;
push (@stackSize, $size);
$style{size} = $size;
$style{weight} = "bold";
}
elsif ($name =~ /^\/(H(1|2|3|4|5|6|7))$/) { # </h1> - </h7>
pop(@stackSize);
my $newSize = $stackSize[-1] || '';
$style{size} = $newSize;
$style{weight} = "normal";
$cw->SUPER::insert ('end',"\x0a\x0a");
$lineWritten = 0;
}
elsif ($name eq "SUP") { # <sup>
if (not length $style{size}) {
$style{size} = $default{size} - 1;
}
else {
$style{size}--;
}
$style{size} = 0 if $style{size} < 0;
$style{offset} += 4;
push (@stackOffset,$style{offset});
push (@stackSize,$style{size});
}
elsif ($name eq "SUB") { # <sub>
if (not length $style{size}) {
$style{size} = $default{size} - 1;
}
else {
$style{size}--;
}
$style{size} = 0 if $style{size} < 0;
$style{offset} -= 2;
push (@stackOffset,$style{offset});
push (@stackSize,$style{size});
}
elsif ($name =~ /^\/(SUP|SUB)$/) { # </sup>, </sub>
pop(@stackOffset);
pop(@stackSize);
$style{size} = $stackSize[-1] || '';
$style{offset} = $stackOffset[-1] || 0;
}
elsif ($name =~ /^(B|STRONG)$/) { # <b>, <strong>
$style{weight} = "bold";
}
elsif ($name =~ /^\/(B|STRONG)$/) { # </b>, </strong>
$style{weight} = "normal";
}
elsif ($name =~ /^(I|EM)$/) { # <i>, <em>
$style{slant} = "italic";
}
elsif ($name =~ /^\/(I|EM)$/) { # </i>, </em>
$style{slant} = "roman";
}
elsif ($name =~ /^(U|INS)$/) { # <u>, <ins>
$style{underline} = 1;
}
elsif ($name =~ /^\/(U|INS)$/) { # </u>, </ins>
$style{underline} = 0;
}
elsif ($name =~ /^(S|DEL)$/) { # <s>, <del>
$style{overstrike} = 1;
}
elsif ($name =~ /^\/(S|DEL)$/) { # </s>, </del>
$style{overstrike} = 0;
}
next;
}
elsif ($sector =~ /^::END::TAG%/i) {
$sector =~ s/^::END::TAG%//i; # strip it
}
# If we're titling, don't bother with tags.
if ($style{titling} == 1) {
# Add this to our page title.
$style{title} .= $sector;
next;
}
# (Re)invent a new tag.
my $tag = join ("-",
$style{family} || $default{font},
$style{size} || $default{size},
$style{foreground} || $default{text},
$style{background} || $default{bgcolor},
$style{weight},
$style{slant},
$style{underline},
$style{overstrike},
$style{justify},
$style{offset},
$style{margin},
$style{hyperlink},
$style{linktag},
$style{pre},
);
$tag =~ s/\s+/+/ig; # convert spaces to +'s.
# Is this a special hyperlink tag?
my $color = $style{foreground} || $default{text};
my $uline = $style{underline};
my $size = (length $style{size} > 0) ? $style{size} : $default{size};
my $ptsize = $cw->_size ($size);
if ($style{hyperlink} == 1) {
# Temporarily reset the color and underline.
$color = $default{link};
$uline = 1;
}
# Configure this tag.
$cw->SUPER::tagConfigure ($tag,
-foreground => $color,
-background => $style{background},
-font => [
-family => $style{family} || $default{font},
-weight => $style{weight},
-slant => $style{slant},
-size => $ptsize,
-underline => $uline,
-overstrike => $style{overstrike},
],
-offset => $style{offset},
-justify => $style{justify},
-lmargin1 => $style{margin},
-lmargin2 => $style{margin},
);
# If this was a hyperlink...
if ($style{hyperlink} == 1) {
# Bind this tag to an event.
my $href = $hyperlinks{$style{linktag}}->{href};
my $target = $hyperlinks{$style{linktag}}->{target};
$cw->SUPER::tagBind ($tag,"<Button-1>", [ sub {
my ($parent,$href,$target) = @_;
# Call our link command.
&{$cw->{hypertext}->{linkcommand}} ($parent,$href,$target);
}, $href, $target ]);
# Set up the hand cursor.
$cw->SUPER::tagBind ($tag,"<Any-Enter>", sub {
$cw->SUPER::configure (-cursor => 'hand2');
});
$cw->SUPER::tagBind ($tag,"<Any-Leave>", sub {
$cw->SUPER::configure (-cursor => 'xterm');
});
}
# If this was preformatted text, preserve the line endings and spacing.
if ($style{pre} == 1) {
# Leave it alone.
}
else {
$sector =~ s/\x0d//sg;
$sector =~ s/\x0a+//sg;
$sector =~ s/\s+/ /sg;
}
# If we wrote something here, inform the rest of the program.
if (length $sector) {
$lineWritten = 1;
}
# Filter escape codes.
while ($sector =~ /&#([^;]+?)\;/i) {
my $decimal = $1;
my $hex = sprintf ("%x", $decimal);
my $qm = quotemeta("&#$decimal;");
my $chr = eval "0x$hex";
my $char = chr($chr);
$sector =~ s~$qm~$char~i;
}
for (my $i = 0; $i < scalar(@escape) - 1; $i += 2) {
my $qm = quotemeta($escape[$i]);
my $rep = $escape[$i + 1];
$sector =~ s~$qm~$rep~ig;
}
# Finally, insert this bit of text.
$cw->SUPER::insert ('end',$sector,$tag);
}
}
sub _size {
my ($cw,$size) = @_;
# Calculate the point size based on the HTML size.
if ($size == 1) {
return 8;
}
elsif ($size == 2) {
return 9;
}
elsif ($size == 3) {
return 10;
}
elsif ($size == 4) {
return 12;
}
elsif ($size == 5) {
return 14;
}
elsif ($size <= 0) {
return 6;
}
elsif ($size >= 6) {
return 16;
}
return 6;
}
sub _heading {
my ($cw,$level) = @_;
# Calculate the point size for each H level.
my %sizes = (
1 => 6,
2 => 5,
3 => 4,
4 => 3,
5 => 2,
6 => 1,
7 => 0,
);
return $sizes{$level};
}
1;
=head1 NAME
Tk::HyperText - Create and manipulate ROText widgets which render HTML code.
=head1 SYNOPSIS
my $hypertext = $mw->Scrolled ("HyperText",
-scrollbars => 'e',
-wrap => 'word',
-linkcommand => \&onLink, # what to do when <a> links are clicked
-titlecommand => \&onTitle, # what to do when <title>s are found
)->pack (-fill => 'both', -expand => 1);
# insert some HTML code
$hypertext->insert ("end","<body bgcolor=\"black\" text=\"yellow\">"
. "Hello, <b>world!</b></body>");
=head1 WIDGET-SPECIFIC OPTIONS
=over 4
=item B<-rerender>
Boolean. When true (the default), the ENTIRE contents of your HyperText widget will
be (re)rendered every time you modify it. In this way, if you insert, e.g. a "bold"
tag and don't close it, then insert new text, the new text should logically still be
in bold, and it would be when this flag is true.
When false, only the newly inserted text will be rendered independently of what else
is already there. If re-rendering the page is too slow for you, try disabling this flag.
=item B<-titlecommand>
This should be a CODEREF pointing to a subroutine that will handle changes in a
page's title. While HTML code is being parsed, when a title tag is found, it will
call this method.
The callback will received the following variables:
$widget = a reference to the HyperText widget that wants to set a title.
$title = the text in the <title> tag.
=item B<-linkcommand>
This should be a CODEREF pointing to a subroutine that will handle the clicking
of hyperlinks.
The callback will received the following variables:
$widget = a reference to the HyperText widget that invoked the link.
$href = the value of the link's "href" attribute.
$target = the value of the link's "target" attribute.
=item B<-attributes>
This option will allow you to define all of the default settings for the display
of HTML pages. Here's an example:
my $html = $mw->Scrolled ("HyperText",
-attributes => {
body => {
bgcolor => 'white',
text => 'black',
link => 'blue',
vlink => 'purple',
alink => 'red',
},
font => {
family => 'Arial',
size => 3,
color => '', # inherit from <body>
back => '', # inherit from <body>
},
},
)->pack;
=back
=head1 DESCRIPTION
Tk::HyperText is a derived Tk::ROText class which supports the automatic rendering
of HTML code. It's designed to be easily useable as a drop-in replacement to any
Tk::ROText widget. Rendering HTML code is as easy as B<insert>ing it as raw HTML,
as shown in the synopsis.
=head1 WIDGET METHODS
In addition to all of the methods exported by Tk::ROText and Tk::Text, the following
methods have special behaviors:
=over 4
=item I<$text-E<gt>>B<insert> I<(where, html-code)>
Insert new HTML code, and render it automatically. Note that currently, only inserting
to the "end" works. See L<"BUGS"> below.
=item I<$text-E<gt>>B<delete> I<(start, end)>
Delete content from the textbox. Note that currently you can only delete EVERYTHING.
See L<"BUGS"> below.
=item I<$text-E<gt>>B<get> I<(start, end)>
Get the HTML code back out of the widget. Note that currently this gets ALL of the code.
See L<"BUGS">. This returns the actual HTML code, not just the text that's been rendered.
=item I<$text-E<gt>>B<clear>
Clear the entire text widget display.
=back
=head1 SUPPORTED HTML
The following HTML tags and attributes are fully supported by this module:
<html>, <head>
<title> *calls -titlecommand when found
<body> (bgcolor, link, vlink, alink, text)
<basefont> (face, size, color)
<font> (face, size, color, back)
<a> (href, target)
<blockquote>
<p>, <br>
<pre>
<code>, <tt>
<center>, <right>, <left>
<h1> - <h6>
<sup>, <sub>
<b>, <strong>
<i>, <em>
<u>, <ins>
<s>, <del>
=head1 EXAMPLE
Run the `demo.pl` program included in the distribution for a demonstration. It's a
kind of simple web browser that views HTML pages in the "demolib" directory, and
supports hyperlinks that link from one page to another.
=head1 BUGS
As noted above, the B<insert> method only inserts at the end, B<delete> deletes
everything, and B<get> gets everything. I plan on coming up with a way to fix this
in a later version.
There are some forms of HTML that might not render properly. For instance, if you
set E<lt>font back="yellow"E<gt>, then set E<lt>font color="red"E<gt>, and then
close the red font, it will also stop the yellow highlight color too. Situations
like this aren't too serious, though. So, if you set one attribute, set them all. ;)
=head1 SEE ALSO
L<Tk::ROText> and L<Tk::Text>.
=head1 CHANGES
0.03 x
- Added support for the <basefont> tag.
0.02 June 20, 2007
- Bugfix: on consecutive insert() commands (without clearing it in between),
the entire content of the HTML already in the widget would be inserted again,
in addition to the new content. This has been fixed.
0.01 June 20, 2007
- Initial release.
=head1 AUTHOR
Casey Kirsle, E<lt>casey at cuvou.netE<gt>
=cut

253
lib/Win32/MediaPlayer.pm Normal file
View File

@ -0,0 +1,253 @@
package Win32::MediaPlayer;
use strict;
use warnings;
use vars qw($VERSION $self $mciSendString $result);
use Win32::API;
$VERSION = '0.2';
BEGIN {
$mciSendString = new Win32::API(
"winmm",
"mciSendString",
['P', 'P', 'N', 'N'], 'N'
)|| die "Can't register mciSendString";
}
sub new {
my $self = {};
bless $self, $_[0];
$self->{alias} = rand;
$self->{pos} = 0;
$self->{play} = 0;
return $self;
}
sub load {
my $self = shift;
my $file = shift;
$result = doMM("open \"$file\" type mpegvideo alias ".$self->{alias});
return $result;
}
sub play {
my $self = shift;
my $pos = shift || $self->{pos};
$self->{play} = 1;
$result = doMM("play ".$self->{alias}." from $pos");
return $result;
}
sub volume {
my $self = shift;
warn 'No File Loaded' if($self->{play}==0);
my $vol = shift;
if($vol ne '') {
$vol*=10;
$result = doMM("setaudio ".$self->{alias}." volume to $vol");
return $result;
}else{
return 'Null';
}
}
sub length {
my $self = shift;
my $flag = shift;
warn 'No File Loaded' if($self->{play}==0);
$result = doMM("status ".$self->{alias}." length");
if($flag) {
my @time = localtime(int($result/1000));
$result = sprintf("%02d:%02d",$time[1],$time[0]);
}
return $result;
}
sub seek {
my $self = shift;
warn 'No File Loaded' if($self->{play}==0);
my $seektime = shift;
if($seektime=~/(\d{2}):(\d{2})/) {
$seektime = ($1*60+$2)*1000;
doMM("stop audiofile");
$result = doMM("play ".$self->{alias}." from $seektime");
}else{
doMM("stop audiofile");
$result = doMM("play ".$self->{alias}." from $seektime");
}
return $result;
}
sub pos {
my $self = shift;
my $flag = shift;
warn 'No File Loaded' if($self->{play}==0);
$result = doMM("status ".$self->{alias}." position");
if($flag) {
my @time = localtime(int($result/1000));
$result = sprintf("%02d:%02d",$time[1],$time[0]);
}
return $result;
}
sub pause {
my $self = shift;
warn 'No File Loaded' if($self->{play}==0);
$result = doMM("pause ".$self->{alias});
return $result;
}
sub resume {
my $self = shift;
warn 'No File Loaded' if($self->{play}==0);
$result = doMM("resume ".$self->{alias});
return $result;
}
sub close {
my $self = shift;
$self->{play} = 0;
$result = doMM("close ".$self->{alias});
return $result;
}
sub doMM {
my($cmd) = @_;
my $ret = "\0" x 1025;
my $rc = $mciSendString->Call($cmd, $ret, 1024, 0);
if($rc == 0) {
$ret =~ s/\0*$//;
return $ret;
} else {
return "error '$cmd': $rc";
}
}
=pod
=head1 NAME
Win32::MediaPlayer - Module for playing sound MP3 / WMA / WAV / MIDI file on Win32 platforms
=head1 SYNOPSIS
use Win32::MediaPlayer;
$winmm = new Win32::MediaPlayer; # new an object
$winmm->load('d:/10.mp3'); # Load music file disk, or an URL
$winmm->play; # Play the music
$winmm->volume(100); # Set volume after playing
$winmm->seek('00:32'); # seek to
#$winmm->pause; # Pause music playing
#$winmm->resume; # Resume music playing
print 'Total Length : '.$winmm->length(1),$/; # Show total time.
while(1) {
sleep 1;
print 'Now Position: '.$winmm->pos(1)."\r"; # Show now time.
};
=head1 DESCRIPTION
This module allows playing of sound format like MP3 / WMA / WAV / MIDI on Win32 platforms using the MCI interface (which
depends on winmm.dll).
=head1 REQUIREMENTS
Only working on Win32, and you should installed the Win32::API
if not you can install by ppm, in the console mode
type command:
ppm install http://www.bribes.org/perl/ppm/Win32-API.ppd
=head1 USAGE
=head2 new
The new method is the constructor. It will build a connection to the mci interface.
$winmm = new Win32::MediaPlayer; # new an object
=head2 load()
$winmm->load('d:/10.mp3'); # Load music from the disk, or Internet URL.
=head2 play
$winmm->play; # Play the music file.
=head2 seek()
The value should be a format like XX:XX, or you can fill the micro second integer of the music.
$winmm->seek(100000); # Seek the music file, at the 100 sec pos.
$winmm->seek('01:40'); # Seek the music file, at the 01 min 40 sec pos.
=head2 close
$winmm->close; # Close the music file.
=head2 volume()
The value is from 0 to 100
$winmm->volume(100); # Set volume to 100 after playing
=head2 length()
Return the music total length
$length = $winmm->length(1); # Return the length in XX:XX format.
$length = $winmm->length; # Return the length in micro second integer.
=head2 pos()
Return the music now position
$length = $winmm->pos(1); # Return the Position in XX:XX format.
$length = $winmm->pos; # Return the Position in micro second integer.
=head2 pause
Pause the music play
$length = $winmm->pause; # Pause the music play.
=head2 resume
Resume the music play
$length = $winmm->resume; # Resume the music play.
=head1 AUTHOR
Lilo Huang
kenwu@cpan.org
http://blog.yam.com/kenwu/
=head1 COPYRIGHT
Copyright 2006 by Lilo Huang All Rights Reserved.
You can use this module under the same terms as Perl itself.
=cut
__END__
1;

BIN
sfx/ding.wav Normal file

Binary file not shown.

BIN
sfx/link.wav Normal file

Binary file not shown.

BIN
sfx/message.wav Normal file

Binary file not shown.

BIN
web.gif Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.5 KiB

BIN
worlds.gif Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.9 KiB

BIN
worlds.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 15 KiB

BIN
worlds.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.9 KiB