Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??
Update: Renamed node and edited description.

It's still really really dirty. It's one of my 'better' scripts, I know there's probably alot of things I could do better, so I do appreciate any feedback. What it does is relay chat between an IRC Channel and the PM Chatterbox. I cleaned out most of my debug code that I had left in, but just commented out. And I started implementation of some sort of HTML filter, but I haven't had a chance to finish it up to make it more 'IRC-friendly'
#!/usr/bin/perl ###### # Copyright (C) 2003 Brent Garber # #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. ##### use warnings; use strict; use POE; use POE::Component::IRC; use POE::Component::Client::HTTP; use XML::Simple; use HTTP::Request::Common qw(GET POST); use HTML::Entities; use HTML::Scrubber; use URI::Escape; use HTTP::Cookies; $|=1; my %GLOBAL = ( nick => 'CBRelay', server => 'irc.remnetworks.org', port => '6667', username => 'PMRelay', ircname => 'I relay chat: PerlMonksCB <-> remnetworks', chan => '#PerlMonks', XMLURL => 'http://www.perlmonks.com/index.pl?node_id=207304', ); $GLOBAL{scrubber} = HTML::Scrubber->new( rules => [a => { href => 1, '*' => 0 } ], default => '0', ); $GLOBAL{cookie} = HTTP::Cookies->new( file => "$ENV{'HOME'}/lwp_cookie +s.dat", autosave => 1, ); POE::Component::IRC->new('remnet') or die "Can't create new: $!\n"; POE::Component::Client::HTTP->spawn( Alias => 'ua', ); POE::Component::Client::HTTP->spawn( Alias => 'pm', CookieJar => $GLOB +AL{cookie}, ); POE::Session->new ( _start => \&bot_start, irc_001 => \&on_connect, irc_public => \&on_public, irc_notice => \&on_notice, irc_msg => \&on_priv, get_xml => \&get_xml, got_response => \&got_response, login_response => \&login_response, post_response => \&post_response, ); sub bot_start { my $kernel = $_[KERNEL]; my $heap = $_[HEAP]; my $session = $_[SESSION]; $kernel->post( remnet => register => "all" ); $kernel->post( remnet => connect => { Nick => "$GLOBAL{nick}", Username => "$GLOBAL{username}", Ircname => "$GLOBAL{ircname}", Server => "$GLOBAL{server}", Port => "$GLOBAL{port}", } ); get_xml(); $kernel->delay('get_xml', 20); } sub on_connect { $_[KERNEL]->post( remnet => join => "$GLOBAL{chan}" ); } sub on_priv { my ( $kernel, $who, $where, $msg ) = @_[ KERNEL, ARG0, ARG1, ARG2 +]; my $nick = ( split /!/, $who )[0]; print "I got message from $nick\n"; $GLOBAL{cookie}->clear; $GLOBAL{cookie}{COOKIES}{'www.perlmonks.com'}{'/'}{'userpass'} = $ +GLOBAL{users}{$nick}{cookie}; if($GLOBAL{users}{$nick}{cookie}) { print "$nick wants to send $msg\n"; $msg = uri_escape($msg); my $url = 'http://www.perlmonks.com/index.pl?node_id=2518&op=m +essage&message=' . $msg . '&message_send=talk'; $kernel->post( pm => request => post_response => GET $url ); } else { print "Not logged in\n"; } } sub on_notice { my ( $kernel, $who, $where, $msg ) = @_[ KERNEL, ARG0, ARG1, ARG2 +]; my $nick = ( split /!/, $who )[0]; if($msg =~ /^\!login\s+(.+?)\s+(.+)/) { print "$nick wants to login with user: $1 and password: $2\n"; my $user = $1; my $password = $2; my $url = 'http://www.perlmonks.com/index.pl?node_id=236515&op +=login&user=' . $user . '&passwd=' . $password . '&ircnick=' . $nick; $kernel->post( pm => request => login_response => GET $url ); } } sub on_public { my ( $kernel, $who, $where, $msg ) = @_[ KERNEL, ARG0, ARG1, ARG2 +]; my $nick = ( split /!/, $who )[0]; my $channel = $where->[0]; my $ts = scalar(localtime); if ( $msg =~ /^data/ ) { foreach(@{$GLOBAL{xml}{message}}) { my $messageid = $_->{message_id}[0]; next if $GLOBAL{lastid} && $messageid <= $GLOBAL{lastid}; format_text($_->{text}[0]); my $message = "<$_->{author}[0]> $_->{text}[0]\n"; $kernel->post( remnet => privmsg => $GLOBAL{chan}, $messag +e ); } if($GLOBAL{xml}{message}->[0]->{message_id}[0]) { $GLOBAL{lastid} = $GLOBAL{xml}{message}->[-1]->{message_id +}[0]; } } } sub send_message { foreach(@{$GLOBAL{xml}{message}}) { my $messageid = $_->{message_id}[0]; next if $GLOBAL{lastid} && $messageid <= $GLOBAL{lastid}; my $text = format_text($_->{text}[0]); my $message = "$_->{author}[0]: $text\n"; $poe_kernel->post( remnet => privmsg => $GLOBAL{chan}, $messag +e ); } if($GLOBAL{xml}{message}->[0]->{message_id}[0]) { $GLOBAL{lastid} = $GLOBAL{xml}{message}->[-1]->{message_id}[0] +; } } sub format_text { my $text = $_[0]; decode_entities($text); $text = $GLOBAL{scrubber}->scrub($text); return $text; } sub post_response { print "Post Response\n"; my ( $heap, $request_packet, $response_packet ) = @_[ HEAP, ARG0, +ARG1 ]; my $http_response = $response_packet->[0]; } sub got_response { my ( $heap, $request_packet, $response_packet ) = @_[ HEAP, ARG0, +ARG1 ]; my $http_request = $request_packet->[0]; my $http_response = $response_packet->[0]{_content}; $GLOBAL{xml} = XMLin($http_response, ForceArray => 'message'); send_message(); $poe_kernel->delay('get_xml', 20); } sub login_response { print "Login\\Post Response\n"; my ( $heap, $request_packet, $response_packet ) = @_[ HEAP, ARG0, +ARG1 ]; my $http_request = $request_packet->[0]; my $http_response = $response_packet->[0]; my $irc = $request_packet->[0]{_uri}; $irc =~ /ircnick\=(.+)/i; $irc = $1; chomp($irc); $GLOBAL{users}{$irc}{cookie} = [ @{$GLOBAL{cookie}{COOKIES}{'www.p +erlmonks.com'}{'/'}{'userpass'}} ]; } sub get_xml { $poe_kernel->post( ua => request => got_response => GET $GLOBAL{XM +LURL} ); } $poe_kernel->run(); exit 0;

In reply to IRC<->CB Relay Bot by OverlordQ

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others making s'mores by the fire in the courtyard of the Monastery: (12)
    As of 2014-12-18 11:33 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      Is guessing a good strategy for surviving in the IT business?





      Results (50 votes), past polls