Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris
 
PerlMonks  

Re: pmchat-2 Unix Patch for Safe signal issue

by jakobi (Pilgrim)
on Sep 28, 2009 at 23:06 UTC ( #798014=note: print w/replies, xml ) Need Help??


in reply to pmchat-2

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...).

Patch -u for just the workaround follows

--- pm_chat2_orig 2009-10-06 13:26:40.540719370 +0200 +++ pm_chat2 2009-10-06 14:15:21.456289356 +0200 @@ -1,6 +1,6 @@ #!/usr/bin/perl -w -my $VERSION = '1.99'; +my $VERSION = '1.99pj_press_return_to_talk'; ## revisions by Sam Denton, aka samwyse; email me at gmail.com ## original program by Nicholas J. Leon, aka mr.nick @@ -30,6 +30,7 @@ use File::Copy; $|++; +my $debug=""; # "dbg"; my $pm = 'http://www.perlmonks.org/index.pl'; my $win32 = ($^O =~ /win32/i); @@ -411,10 +412,16 @@ 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; + #$old = $readline::line; + $ans=""; die }; @@ -424,11 +431,18 @@ ## I need that so I can restuff it back in. alarm($config{timeout}) unless $win32; - $message = $term->readline("Talk: ", $old); - $old = $readline::line = ''; + #$message = $term->readline("Talk$debug: ", $old); + #$old = $readline::line = ''; + $ans=<>; # PJ - user wants to talk alarm(0) unless $win32; }; + if ($ans) { + $message=$term->readline("Talk> ",""); + $message="" if not $message; + } + + do{warn "did see> $message\n" if $message; $message=""} if $debug; $message; } @@ -474,7 +488,7 @@ newnodes() if $config{newnodesonlaunch}; getprivatemessages; getmessages(); -print "Type /help for help.\n"; +print "Type <CR> for talk prompt (/help for available prompt commands +)\n"; while (1) { getprivatemessages;

Update: Slight clean up. The 2nd variant below does fix the ALRM issue nicely, but I cannot get the partial user input when interrupted, regardless of using PERL_RL=Gnu or not; which makes it impossible to type longer answers, esp. with a low timeout. So this version is the one to use for now.

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.

pm_chat2 in the version I'm currently using (as of 20091021; slightly extended, see /help), and which I'll keep updated in this node.

#!/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"; }

Replies are listed 'Best First'.
Re^2: pmchat-2
by Anonymous Monk on Sep 28, 2009 at 23:40 UTC
    Maybe you need unsafe signals?

      (5.8 sounds interesting from the time frame. Will check this tomorrow & update this reply node. thx!)

      OK/fail*: just setting PERL_SIGNALS=unsafe in the shell indeed does the trick, however this affects the whole program, even if it makes the original program work again.

      FAIL: there are low level readline lib variables with interesting names e.g. in Term::ReadLine::Gnu: _rl_vars{rl_catch_signals}=['C',20]; however these reliably fail for me as I'm too lazy to actually read both the library and XS to make sense of them :/.

      FAIL: there were some related pointers via google that PERLIO=perlio instead of stdio solves some recent trouble with 5.10 with IO. Changing the environment variable alone is insufficient. And readline might well do it's own IO in parallel to perlio!?

      probably OK and localized: Perl::Unsafe::Signals

      OK/fail* and localized: POSIX::sigaction, see search.cpan.org/~dapm/perl-5.10.1/pod/perlrun.pod#PERL_SIGNALS and search.cpan.org/~dapm/perl-5.10.1/pod/perlipc.pod#Deferred_Signals_(Safe_Signals) (sorry, the shortcut perlipc and perlrun docs are different, incomplete versions; thus the cpan links instead).

      *) "fail" as I cannot see a way to get the partial line on ALARM. For both POSIX::sigaction and also PERL_SIGNALS=unsafe, the original way to access it seems broken.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://798014]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others romping around the Monastery: (4)
As of 2020-12-02 04:08 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    How often do you use taint mode?





    Results (28 votes). Check out past polls.

    Notices?