I had problems in using this script, as at least on recent Linux systems (Ubuntu jaunty 64bit), readline doesn't honor ALRM at all.
The following workaround is a bit simpleminded, but at least automatically updates the display every n seconds, at the cost of the user entering an extra CR to reach the readline prompt (just normal reading from stdin, which still honors ALRM...).
There's also a little issue when PM doesn't return a page. Can happen every few hours, leading
to XMLin dying, as LWP didn't provide sane input and the return isn't tested. It seems to be sufficient to change the XMLin statements to my $xml; eval{$xml = XMLin($r->content)}; return if $@;. Another small one in case you print timestamps: Change the unpack template from 8x to 10x to account for the modified timestamp fields. chmod 0600 on cookie file. Changed to add the node titles on numeric id:// links.
Note that type-ahead isn't affected by the alarm issue, so I now just insert the type-ahead into the readline handling in case you start typing w/o pressing RETURN first for the readline-prompt. This way start typing, press RETURN for full line editing and continue typing, then press a 2nd RETURN to send the message.
#!/usr/bin/perl -w
## A text mode client for the Chatter Box of Perl Monks
# This is not an attempt to be complete, but small and useful
# Use it or not. No guarantee, no warranty, blah blah
#
# And guaranteed to truncate your overly long messages silently
## Usage: pm_chat2 [--debug] [--config file] [--cookie file]
## revisions by Sam Denton, aka samwyse; email me at gmail.com
# original program by Nicholas J. Leon, aka mr.nick
# samwyse's thread & official version: id://720870
# interim unix variant Peter's currently using: id://798014
# 20091024pj
my $VERSION = '1.99pj_press_return_to_talk_on_unix';
## Now supports Win32 installations with a different ReadLine call.
## Autoupdate now actually autoupdates
## Oh, and it has no error checking :)
## You might wish to try unsetting (some of) win32 when using
# this within cygwin, with getline* maybe the exception to retain.
## PJ 2009-09 some changes to account for safe signal change
# (at some loss of comfort; can still be redirected
# to a file or used within a pipe)
use strict;
use XML::Simple;
use LWP::Simple;
use LWP::UserAgent;
use HTTP::Cookies;
use HTTP::Request::Common;
use Data::Dumper;
use Text::Wrap qw($columns wrap);
use Term::ReadLine;
use Term::ReadKey qw(GetTerminalSize ReadLine ReadMode);
use HTML::Parser;
use File::Copy;
# PJ
$|++;
my $debug=""; # "dbg"; # set to a string to turn on no-submission/debu
+gging output
my $pm = 'http://www.perlmonks.org/index.pl';
my $win32 = ($^O =~ /win32/i);
my $home = $win32 ?
( $ENV{HOME} || $ENV{APPDATA} || $ENV{USERPROFILE} || "." ) :
( $ENV{HOME} || "." );
my $cookie = "$home/.pmcookie";
my $cffile = "$home/.pmconfig";
while($_=$ARGV[0]){
/^-?-debug/o and do{shift; $debug="debug"; next};
/^-?-config/o and do{shift; $cookie=shift; next};
/^-?-cookie/o and do{shift; $cffile=shift; next};
/^-(h|-?help|\?)$/o and do{die "$0 [--debug] [--config FILE] [--co
+okie FILE] "};
/^--?$/o and do{shift; last};
last;
}
my %config = (
timestamp => 0,
colorize => 1,
browser => 'lynx "$file"', # use %s, otherwise the file i
+s place into $ENV{file}
newnodes => 25,
updateonlaunch => 0,
xponlaunch => 1,
whoonlaunch => 1,
newnodesonlaunch => 0,
expandtitle => 1,
user => "",
timeout => 15,
timeoffset => 6*3600, # PJ for now adjust here or in the c
+onfig file
# about 4 times a year...
homepage => 'http://www.perlmonks.org/?displaytype=display
+code;node_id=720870',
browsersite => 'http://www.perlmonks.org',
xtermtitle => "\e]0;pm_chat2\007",
);
my %seenmsg;
my %seenprv;
my %xp;
my $ua;
## some color stuff (if you want)
my %colormap =
(
node => [ "\e[33m", "\e[0m" ],
user => [ "\e[1m", "\e[0m" ],
code => [ "\e[32m", "\e[0m" ],
me => [ "\e[36m", "\e[0m" ],
private => [ "\e[35m", "\e[0m" ],
important => [ "\e[1;34m", "\e[0m" ],
timestamp => [ "\e[38;5;36m", "\e[0m" ],
);
## <readmore>
######################################################################
######################################################################
sub writeconfig {
unless (open(OUT, ">",$cffile)) {
warn "Couldn't open '$cffile' for writing: $!\n";
return;
}
print OUT "$_ $config{$_}\n" for keys %config;
close OUT;
chmod 0600, $cookie, $cffile;
}
sub readconfig {
chmod 0600, $cookie, $cffile;
unless (-r $cffile) {
warn "'$cffile' does not exist, skipping.\n";
return;
}
unless (open(IN, "<", $cffile)) {
warn "Couldn't open '$cffile' for reading: $!\n";
return;
}
%config =( %config, (map /^([^\s]+)\s+(.+)$/, <IN>));
close IN;
}
## testing ... autoupdate
sub autoupdate {
my $quiet = shift;
my $r = $ua->request(GET "$config{homepage}");
unless ($r) {
print "Unable to access the most recent version via the Internet.\
+n";
return;
}
$r->content =~ /^\s*my\s*\$VERSION\s*=\s*'(\d+\.\d+)'\s*;\s*$/m;
unless ($1) {
print "Unable to parse the version number found at $config{homepag
+e}.\n";
return;
}
my $ver = $1;
print "This version is $VERSION, the most recent version is $ver.\n"
unless $quiet;
if ($VERSION >= $ver) {
print "There is no need to update.\n" unless $quiet;
return;
}
print "Version $ver is available.\n";
my $tmp = $ENV{TMP} || $ENV{TEMP} || "/tmp";
my $fn = "$tmp/pmchat-$ver";
unless (open (OUT, ">", $fn)) {
print "Unable to save newest version to $fn\n";
return;
}
print OUT $r->content;
close OUT;
## a couple checks here: we can autoupdate IF the following are true
if ($win32) {
print "Sorry, autoupdate is not available for Windows installation
+s.\n";
print "The newest version has been saved in $tmp/pmchat.$ver.\n";
return;
}
## moving the old version someplace else
if (!move($0, "$0.bak")) {
print "Couldn't move $0 to $0.bak, aborting.\n";
print "The newest version has been saved in $fn.\n";
return;
}
## moving the new version to the old's location
if (!move($fn, $0)) {
print "Couldn't move $fn to $0, aborting $!.\n";
move("$0.bak", $0);
print "The newest version has been saved in $fn.\n";
return;
}
## okay! Reload!
chmod 0755, $0;
writeconfig;
exec $0;
}
######################################################################
######################################################################
sub colorize {
my $txt = shift;
my $type = shift;
return $txt unless $config{colorize};
return $txt if $win32;
"$colormap{$type}[0]$txt$colormap{$type}[1]";
}
sub user {
colorize(shift, "user");
}
sub imp {
colorize(shift, "important");
}
sub content {
my $txt = shift;
return $txt unless $config{colorize};
return $txt if $win32;
unless ($txt =~ s/\<code\>(.*)\<\/code\>/$colormap{code}[0]$1$colorm
+ap{code}[1]/mig) {
$txt =~ s/\[([^\]]+)\]/$colormap{node}[0]$1$colormap{node}[1]/g;
}
$txt;
}
######################################################################
######################################################################
sub cookie {
$ua->cookie_jar(HTTP::Cookies->new());
$ua->cookie_jar->load($cookie);
}
sub login {
my $user;
my $pass;
## fixed <> to <STDIN> via merlyn
print "Enter your username: "; chomp($user = <STDIN>);
print "Enter your password: ";
ReadMode 2; chomp($pass = <STDIN>); ReadMode 0;
$ua->cookie_jar(HTTP::Cookies->new(file => $cookie,
ignore_discard => 1,
autosave => 1,
)
);
my $r = $ua->request( POST ($pm, [
op => 'login',
user => $user,
passwd => $pass,
expires => '+1y',
node_id => '16046'
]));
chmod 0600, $cookie;
}
sub xp {
my $r = $ua->request(GET("$pm?node_id=16046"));
my $xml; eval{$xml = XMLin($r->content)}; return if $@;
$config{xp} = $xml->{XP}->{xp} unless defined $config{xp};
$config{level} = $xml->{XP}->{level} unless defined $config{level}
+;
my $user=user($xml->{INFO}->{foruser});
# PJ if unset, remember the user name for /self, if the dummy's co
+lor marked UGH
# which somewhat clashes as otherwise the username is only part
+ of the cookie
# and nowhere used in the script. Maybe place a copy of the net
+rc stuff
# from pm_vi?
do{$config{user}=$user; $config{user}=~s/\x1b\[\d+m//g;} if not $c
+onfig{user};
print "\nYou are logged in as $user.\n";
print "You are level $xml->{XP}->{level} ($xml->{XP}->{xp} XP).\n"
+;
if ($xml->{XP}->{level} > $config{level}) {
print imp "You have gained a level!\n";
}
print "You have $xml->{XP}->{xp2nextlevel} XP left until the next
+level.\n";
if ($xml->{XP}->{xp} > $config{xp}) {
print imp "You have gained ".($xml->{XP}->{xp} - $config{xp})."
+experience!\n";
}
elsif ($xml->{XP}->{xp} < $config{xp}) {
print imp "You have lost ".($xml->{XP}->{xp} - $config{xp})." ex
+perience!\n";
}
($config{xp}, $config{level}) =( $xml->{XP}->{xp}, $xml->{XP}->{le
+vel});
print "\n";
}
sub who {
my $req = GET("$pm?node_id=15851");
my $res = $ua->request($req);
my $ref; eval{$ref = XMLin($res->content, forcearray => 1)}; return
+ if $@;
print "\nUsers current online (";
print $#{$ref->{user}} + 1;
print "):\n";
print wrap "\t", "\t", map { user($_->{username})." " } @{$ref->{use
+r}};
print "\n";
}
sub newnodes {
my $req = GET("$pm?node_id=30175");
my $res = $ua->request($req);
my $ref; eval{$ref = XMLin($res->content, forcearray => 1)}; return
+if $@;
my $cnt = 1;
my %users = map { ($_->{node_id}, $_->{content}) } @{$ref->{AUTHOR}}
+;
print "\nNew Nodes:\n";
if ($ref->{NODE}) {
for my $x (sort { $b->{createtime} <=> $a->{createtime} } @{$ref->
+{NODE}}) {
print wrap "\t", "\t\t",
sprintf("%d. [%d] %s by %s (%s)\n", $cnt,
$x->{node_id}, $x->{content},
user(defined $users{$x->{author_user}} ? $users{$x->{aut
+hor_user}}:"Anonymous Monk"),
$x->{nodetype});
last if $cnt++ == $config{newnodes};
}
}
print "\n";
}
######################################################################
######################################################################
sub showmessage {
my $msg = shift;
my $type = shift || '';
my $fmt = colorize("%02d:%02d ", "timestamp"); # PJ safe as %coloriz
+e doesn't add %
my $tmplt = "A10xA2xA2xA2"; # PJ A10 instead of A
+8
for my $k (keys %$msg) {
$msg->{$k} =~ s/^\s+|\s+$//g
}
# PJ expand id:// to be include ID and title on printout
$config{expandtitle} and do {
# mark title-links with "" also in redirected output
$msg->{content}=~s/\[(?![a-z]+:\/\/\d+).*?\]/"$&"/gi;
# get title
$msg->{content}=~s{\[id:\/\/(\d+)\s*\]}{do{
my($id,$n,$r,$title,$txt)=($&,$1,undef,"","NOTITLE");
eval{ $txt=$ua->request(GET("$pm?node_id=$n&displaytype=xml&xmls
+tyle=flat"))->content };
$txt=~m!<node .*?\btitle="([^"]+)"!m and $title="|".$1;
"[id://$n$title]"
}}ge;
# looks like both ID and ALT_TITLE are printed for others'
# and my own messages
# $msg->{content}=~s/\[id:\/\/(\d+)\s*\|.*?\]/$& ($1)/g;
};
print "\r";
# PJ the xml ticker seems to return something like EST inspite of
# the use of GMT in the header...
my $tmp="";
if ($config{timestamp}) {
my ($tmph,$tmpm)=(unpack($tmplt, $msg->{time}))[1..2];
$tmp=(3600*(24+$tmph)+60*$tmpm+$config{timeoffset}) % 86400;
$tmpm=0;
$tmph=$tmp/3600;
$tmph=~s/(\..*)$//o and $1 and $tmpm=$1*60;
$tmpm=~s/(\..*)$//o;
$tmp=sprintf $fmt, $tmph, $tmpm;
}
if ($type eq 'private') {
print wrap('', "\t",
$tmp.
colorize("$msg->{author} says $msg->{content}", "privat
+e").
"\n");
}
else {
if ($msg->{content} =~ s/^\/me\b/$msg->{author}/) {
print wrap('', "\t",
$tmp.
colorize("$msg->{content}", "me"),
"\n");
}
else {
print wrap('', "\t",
$tmp.
colorize($msg->{author}, "user").
": ".
content($msg->{content}).
"\n");
}
}
}
sub getmessages {
my $req = GET("$pm?node_id=15834");
my $res = $ua->request($req);
warn $res->content if not $res->is_success;
return if not $res->is_success;
my $ref; eval{ $ref = XMLin($res->content, forcearray => 1 )}; retur
+n if $@;
if (defined $ref->{message}) {
for my $mess (@{$ref->{message}}) {
## ignore this message if we've already printed it out
next if $seenmsg{"$mess->{user_id}:$mess->{time}"}++;
showmessage $mess;
}
}
else {
## if there is nothing in the list, reset ours
undef %seenmsg;
}
}
sub getprivatemessages {
my $req = GET("$pm?node_id=15848");
my $res = $ua->request($req); return if not $res->is_success;
my $ref; eval { $ref = XMLin($res->content, forcearray => 1)}; retur
+n if $@;
if (defined $ref->{message}) {
for my $mess (@{$ref->{message}}) {
## ignore this message if we've already printed it out
next if $seenprv{"$mess->{user_id}:$mess->{time}"}++;
showmessage $mess, "private";
}
}
else {
undef %seenprv;
}
}
sub postmessage {
# Q check errors and retry sending??
my $msg = shift;
my $req = POST ($pm, [
op => 'message',
message => $msg,
node_id => '16046',
]);
$ua->request($req);
}
sub node {
my $id = shift;
my $field;
if ($id=~/^\s*(\d+)\s*$/o) {
$field="node_id";
$id=$1 if $id=~/^\s*(\d+)\s*$/;
} else {
$field="node";
$id=$1 if $id=~/^\s*(\S*.*?\S)\s*$/;
}
my $browser=$config{browser};
$browser.=' "$file"' if $browser!~/\%s|\$file/o; # PJ, Unix: append
+$file as default if neither arg
if ($browser=~/\%s/) {
# unsafe when allowing arbitrary node strings instead of just nod
+e_id
# works with windows, too
system(sprintf($browser, "$config{browsersite}/?$field=$id"));
} else {
# safe version is used when no %s is provided
# though this might be Unix only?
$ENV{file}="$config{browsersite}/?$field=$id";
system($browser);
}
}
sub help {
print <<EOT
The following /COMMANDs are available:
/help :: Shows this message.
/newnodes :: Displays a list of the newest nodes (of all types
+)
posted. The number of nodes displayed is limited
+by
the "newnodes" user configurable variable.
Also aliases /new, /news.
/node ID :: Retrieves the passed node and launches your brows
+er
(optional %s or "\$file"; browser=$config{browser
+};
both numerical ID and title allowed)
/reload :: UNIX ONLY. Restarts pmchat.
/self :: Message yourself e.g. a shortcut url (user=$confi
+g{user}).
/set :: Displays a list of all the user configurable
variables and their values.
/set X Y :: Sets the user configurable variable X to value Y.
/update :: Checks for a new version of pmchat, and if it
exists, download it into a temporary location.
This WILL NOT overwrite your current version.
(likely to fail with the modified PJ version)
/quit :: Exits pmchat.
/who :: Shows a list of all users currently online.
/xp :: Shows your current experience and level.
/COMMANDs forwarded to the server:
/chatteron /chatteroff /ignore /unignore
/em /me /me's :: Sends action to all.
/msg /tell :: Sends message to specific user/[a user].
text :: Sends message to all (if without leading /).
Bots to /msg:
im2 :: said, alarm, karma, set timezone (see /node im2)
EOT
;
}
######################################################################
######################################################################
my $old;
my $term = new Term::ReadLine 'pmchat';
sub getlineUnix {
my $message;
my $ans; # PJ insert $ans for the timeout handling,
# as safe signals don't interrupt ReadLine anymore
# and I cannot seem to find the partial input line
$message=$ans="";
#warn "\n.\n" if $debug;
eval {
local $SIG{ALRM}=sub {
#$old = $readline::line;
$ans="";
die
};
## I don't use the version of readline from ReadKey (that includes
## a timeout) because this version stores the interrupted (what
## was already typed when the alarm() went off) text in a variable
+.
## I need that so I can restuff it back in.
alarm($config{timeout}) unless $win32;
#$message = $term->readline("Talk$debug: ", $old);
#$old = $readline::line = '';
$ans=<STDIN>; # PJ - user wants to talk
alarm(0) unless $win32;
};
if ($ans) {
$ans=~s/\n/ /g;
$ans="" if $ans eq " ";
print "\n" if $ans; # \n on type-ahead to avoid visual confusion
$message=$term->readline("Talk> ",$ans);
$message="" if not $message;
}
do{warn "did see> $message\n" if $message; $message=""} if $debug;
$message;
}
sub getlineWin32 {
## unfortunately, there is no way to preserve what was already typed
## when the timeout occured. If you are typing when it happens,
## you lose your text.
my $message = $term->readline("Talk: ");
$message;
}
## initialize our user agent
$ua=LWP::UserAgent->new;
$ua->agent("pmchat-samwyse");
## trap ^C's
## for clean exit
$SIG{INT}=sub {
writeconfig;
chmod 0600, $cookie, $cffile;
exit
};
## load up our config defaults
readconfig;
## for text wrapping
$columns = (GetTerminalSize)[0] || $ENV{COLS} || $ENV{COLUMNS} || 80;
if (-e $cookie) {
cookie;
}
else {
login;
}
print $config{xtermtitle} if $config{xtermtitle};
print "This is pmchat version $VERSION.\n";
autoupdate(1) if $config{updateonlaunch};
xp() if $config{xponlaunch};
who() if $config{whoonlaunch};
newnodes() if $config{newnodesonlaunch};
my $first=0;
while (1) {
getprivatemessages;
getmessages;
print "Type <CR> for talk prompt (/help for available prompt command
+s)\n" if not $first++;
#my $message = $win32 ? getlineWin32() : getlineUnix();
my $message = getlineUnix();
if (defined $message) {
## we understand a couple of commands
$message =~ s/^\s*//;
$message =~ s/\s*\Z//;
if ($message =~ /^\/who\b/i) {
who;
}
elsif ($message =~ /^\/q(uit)?\b/i) {
writeconfig;
exit;
}
elsif ($message =~ /^\/set\s+([^\s]+)\s+(.+)$/) {
$config{$1} = $2;
print "$1 is now $2\n";
}
elsif ($message =~ /^\/set$/) {
my $width = 0;
map { $width = length() if $width < length() } keys %config;
for my $k (sort keys %config) {
printf "\t%-${width}s %s\n", $k, $config{$k};
}
}
elsif ($message =~ /^\/new(\s*node)?s?\b/) {
newnodes;
}
elsif ($message =~ /^\/xp\b/) {
xp;
}
elsif ($message =~ /^\/node\s+(.*?)\s*$/) {
node($1);
}
elsif ($message =~ /^\/h(elp)?\b/) {
help;
}
elsif ($message =~ /^\/reload\b/) {
print "Reloading $0!\n";
writeconfig;
exec $0;
}
elsif ($message =~ /^\/update\b/) {
autoupdate;
}
elsif ($message =~ /^\/(self)\b/) {
if ($config{user}) {
$message=~s/^\/self/\/msg $config{user}/;
postmessage($message);
} else {
print "Who are you? Please go away or set user.\n";
}
}
elsif ($message =~ /^\/(msg|me|em|tell|(un)?ignore|chattero(ff|n))
+\b/) {
postmessage($message);
}
elsif ($message =~ /^\//) {
print "Unknown command '$message'.\n";
}
elsif ($message =~ /^\s*$/) {
;
}
else {
# PJ standardize @name and name: at beginning
$message=~s/^(\w+):/\[$1\|$1:\]/; $message=~s/^\@(\w+)/\[$1\|\@$
+1\]/;
postmessage($message);
}
}
}
pm_self: A quick&dirty crippled down companion version to just message yourself.
Suited to resolve shortcut urls and nothing else (pointers to maintained Unix-capable replacements:
welcome, *: a wrong thing(TM) to do and even worse to publish, I know)
#!/usr/bin/perl -w
# cut down version of pm_chat2 skeleton to just send a msg to yourself
# usage: pm_self MSG; echo MSG | pm_self
#
# maybe if a use is there, add a -?-to option, for now I'm only intere
+sting
# in talking to myself, e.g. sending links and have them formatted and
+ at
# most check the inbox to see if I should log in.
#
# see pm_chat2 for the real thing: id://720870
use strict;
use XML::Simple;
use LWP::Simple;
use LWP::UserAgent;
use HTTP::Cookies;
use HTTP::Request::Common;
use Data::Dumper;
use Text::Wrap qw($columns wrap);
use HTML::Parser;
use Term::ReadKey qw(ReadMode);
$|++;
my $debug=""; # "dbg"; # set to a string to turn on no-submission/debu
+gging output
my $timecol="\x1b[38;5;36m"; # color for shortened time string of hh:d
+d
my $pm = 'http://www.perlmonks.org/index.pl';
my $win32 = ($^O =~ /win32/i);
my $home = $win32 ?
( $ENV{HOME} || $ENV{APPDATA} || $ENV{USERPROFILE} || "." ) :
( $ENV{HOME} || "." );
my $cookie = "$home/.pmcookie";
my $cffile = "$home/.pmconfig";
my %config = (
timestamp => 0,
colorize => 1,
browser => '/usr/bin/lynx "$file"',
newnodes => 25,
updateonlaunch => 0,
xponlaunch => 1,
whoonlaunch => 1,
newnodesonlaunch => 0,
user => "",
timeout => 15,
timeoffset => 6*3600, # PJ for now adjust here or in the c
+onfig file
# about 4 times a year...
homepage => 'http://www.perlmonks.org/?displaytype=display
+code;node_id=720870',
);
my %xp;
my $ua;
sub readconfig {
unless (-r $cffile) {
warn "'$cffile' does not exist, skipping.\n";
return;
}
unless (open(IN, $cffile)) {
warn "Couldn't open '$cffile' for reading: $!\n";
return;
}
%config =( %config, (map /^([^\s]+)\s+(.+)$/, <IN>));
close IN;
}
sub cookie {
$ua->cookie_jar(HTTP::Cookies->new());
$ua->cookie_jar->load($cookie);
}
sub getprivatemessages {
my $req = GET("$pm?node_id=15848");
my $res = $ua->request($req);
my $ref; eval { $ref = XMLin($res->content, forcearray => 1)}; retur
+n if $@;
if (defined $ref->{message}) {
print "You have messages:\n\n";
for my $mess (@{$ref->{message}}) {
print $mess->{author} ." on ". $mess->{"time"} .": ".
$mess->{content} ."\n\n";
}
print "__END__\n";
}
}
sub login {
my $user;
my $pass;
## fixed <> to <STDIN> via merlyn
print "Enter your username: "; chomp($user = <STDIN>);
print "Enter your password: ";
ReadMode 2; chomp($pass = <STDIN>); ReadMode 0;
$ua->cookie_jar(HTTP::Cookies->new(file => $cookie,
ignore_discard => 1,
autosave => 1,
)
);
my $r = $ua->request( POST ($pm, [
op => 'login',
user => $user,
passwd => $pass,
expires => '+1y',
node_id => '16046'
]));
}
sub postmessage {
my $msg = shift;
my $req = POST ($pm, [
op => 'message',
message => $msg,
node_id => '16046',
]);
$ua->request($req);
}
my $old;
## initialize our user agent
$ua=LWP::UserAgent->new;
$ua->agent("pmmsg-jakobi");
## load up our config defaults
readconfig;
if (-e $cookie) {
cookie;
}
else {
login;
}
my $message;
die "Set user in config\n" if $config{user}!~/\S/;
if (not $message) {
if (@ARGV) {
$message = join(" ", @ARGV);
@ARGV=();
} else {
$message=<STDIN>;
}
}
getprivatemessages;
if ($message=~/\S/) {
my $res=postmessage("/msg $config{user} ".$message) if $message=~/\
+S/;
$res->is_success or die "POST Error: " . $res->status_line . "\n";
print $res->status_line, "\n";
}