Here's a big ol' perl module to access E2's chatterbox through the XML/http interface. Note this is not a chatterbox client in and of itself, but that a chatterbox client can be built upon it.
The pod at the bottom has examples of use. This requires
the chatterbox parser
and the private messages parser modules.
package E2Chatterbox2;
use constant E2 => 'http://www.everything2.com';
use constant MAX_CHATTER => 500;
use strict;
use HTTP::Cookies;
use HTTP::Request::Common;
use LWP::UserAgent;
use XML::Parser;
use E2ChatterboxCParser; # chatter parser
use E2ChatterboxMParser; # personal message parser
sub new {
my $proto = shift();
my $class = ref( $proto ) || $proto;
my $self = {
ua => undef,
cookie => undef,
chatter => [],
chatter_parser => undef,
chatter_data => undef,
chatter_req => undef,
chatter_time => undef,
msg => [],
msg_parser => undef,
msg_data => undef,
msg_req => undef,
};
bless( $self, $class );
$self->_initialize();
return $self;
}
sub delete_messages {
my $self = shift();
return $self->send_message( "", @_ );
}
sub get_all {
my $self = shift();
my $chatter_xml = $self->_get_chatter();
$chatter_xml =~ s/\&/\&/g;
$self->chatter_data( $chatter_xml );
$self->_parse_chatter();
my $offset = scalar( @{$self->chatter()} ) - MAX_CHATTER;
if ( $offset > 0 ) {
$self->chatter( [ splice( @{$self->chatter()}, $offset ) ] );
}
if ( defined($self->cookie()) ) {
my $msg_xml = $self->_get_msg();
$msg_xml =~ s/\&/\&/g;
$self->msg_data( $msg_xml );
$self->_parse_msg();
}
return ( $self->chatter(), $self->msg() );
}
sub goto_room {
my $self = shift();
my $room = shift() || 'outside';
return undef unless ( defined( $self->cookie() ) );
my $room_id = 0;
$room = lc( $room );
if ( $room eq 'asylum' ) { $room_id = 553129; }
my $req = HTTP::Request::Common::POST( E2,
[
changeroom => $room_id,
# node => 'private message XML ticker', # don't work, need
node_id => 104, # to use node_id?
sexiscool => 'go',
],
'Content-type' => 'multipart/form-data'
);
my $response = $self->ua()->request( $req );
return undef unless ( $response->is_success() );
return 1;
}
sub login {
my $self = shift();
my $username = shift() || return undef;
my $password = shift() || return undef;
my $req = HTTP::Request::Common::POST( E2,
[
op => 'login',
node => 'private message XML ticker',
user => $username,
passwd => $password,
] );
my $response = $self->ua()->request( $req );
#
# check to see if we're now logged in by scanning the entire
# cookie jar and looking for a cookie whose key is 'userpass'
# and whose domain includes the string 'everything2'.
#
# returns that cookie value if found, undef if not
#
my $jar = $self->ua()->cookie_jar();
my $cookie = undef;
$jar->scan( sub {
$cookie = $_[2] if ($_[1] eq 'userpass' &&
$_[4] =~ m/everything2/i);
} );
return $self->cookie( $cookie );
}
sub send_message {
my $self = shift();
my $message = shift() || '';
return undef unless ( defined( $self->cookie() ) );
my %delete_these = map { "deletemsg_".$_ => 'yup' } @_;
my $req = HTTP::Request::Common::POST( E2,
[
op => 'message',
message => $message,
node => 'chatterbox XML ticker',
%delete_these,
],
'Content-type' => 'multipart/form-data'
);
my $response = $self->ua()->request( $req );
return undef unless ( $response->is_success() );
return 1;
}
#############################################################
#############################################################
###
### private methods
###
#############################################################
#############################################################
sub _initialize {
my $self = shift();
my $ua = new LWP::UserAgent; # the user-agent
my $jar = new HTTP::Cookies; # the ua's cookie jar
$ua->cookie_jar( $jar );
$self->ua( $ua );
$self->chatter_req( HTTP::Request::Common::GET( E2 .
"/?node=chatterbox+XML+ticker" ) );
$self->chatter_parser(
new XML::Parser( Style => 'E2Chatterbox::ChatterParser' ) );
$self->chatter_time( 0 );
$self->msg_req( HTTP::Request::Common::GET( E2 .
"/?node=private+message+XML+ticker" ) );
$self->msg_parser(
new XML::Parser( Style => 'E2Chatterbox::MsgParser' ) );
}
sub _dump_chatter {
my $self = shift();
foreach my $line ( @{$self->chatter()} ) {
my ( $time, $speaker, $speech ) = @$line;
print "[$time] $speaker: $speech\n";
}
}
sub _dump_msg {
my $self = shift();
foreach my $line ( @{$self->msg()} ) {
my ( $time, $speaker, $speech, $id ) = @$line;
print "[$time] $speaker ($id): $speech\n";
}
}
sub _get_chatter {
my $self = shift();
my $response = $self->ua()->request( $self->chatter_req() );
return undef unless ( $response->is_success() );
return $self->chatter_data( $response->content() );
}
sub _get_msg {
my $self = shift();
my $response = $self->ua()->request( $self->msg_req() );
return undef unless ( $response->is_success() );
return $self->msg_data( $response->content() );
}
sub _parse_chatter {
my $self = shift();
my $chatter_xml = shift() || $self->chatter_data() || return undef;
eval {
my ( $new_chatter, $new_time ) =
$self->chatter_parser()->parse( $chatter_xml,
'last_time' => $self->chatter_time() );
push( @{$self->chatter()}, @$new_chatter );
$self->chatter_time( $new_time );
};
return $@;
}
sub _parse_msg {
my $self = shift();
my $msg_xml = shift() || $self->msg_data() || return undef;;
eval {
my $new_msg = $self->msg_parser()->parse( $msg_xml );
$self->msg( $new_msg );
};
return $@;
}
######################################################################
######################################################################
###
### Accessor methods
###
######################################################################
######################################################################
sub cookie { my $self=shift; return @_ ?
$self->{cookie}=shift : $self->{cookie}; }
sub ua { my $self=shift; return @_ ?
$self->{ua}=shift : $self->{ua}; }
sub chatter { my $self=shift; return @_ ?
$self->{chatter}=shift : $self->{chatter}; }
sub chatter_parser { my $self=shift; return @_ ?
$self->{chatter_parser}=shift : $self->{chatter_parser}; }
sub chatter_data { my $self=shift; return @_ ?
$self->{chatter_data}=shift : $self->{chatter_data}; }
sub chatter_req { my $self=shift; return @_ ?
$self->{chatter_req}=shift : $self->{chatter_req}; }
sub chatter_time { my $self=shift; return @_ ?
$self->{chatter_time}=shift : $self->{chatter_time}; }
sub msg { my $self=shift; return @_ ?
$self->{msg}=shift : $self->{msg}; }
sub msg_parser { my $self=shift; return @_ ?
$self->{msg_parser}=shift : $self->{msg_parser}; }
sub msg_data { my $self=shift; return @_ ?
$self->{msg_data}=shift : $self->{msg_data}; }
sub msg_req { my $self=shift; return @_ ?
$self->{msg_req}=shift : $self->{msg_req}; }
1;
######################################################################
######################################################################
###
### POD
###
######################################################################
######################################################################
=pod
=head1 NAME
E2Chatterbox2 - Everything2 chatterbox client, v.2
=head1 SYNOPSIS
use E2Chatterbox2;
my $cbox = new E2Chatterbox2;
$cbox->login( $username, $password );
$cbox->send_message( "Hello, World!" ); # send a message
$cbox->delete_messages( @message_ids ); # delete private messages
my ($chatter_ref, $msg_ref) = $cbox->get_all();
print join ("\n", map { join(", ") } @$chatter_ref )."\n";
print join ("\n", map { join(", ") } @$msg_ref )."\n";
=head1 PUBLIC METHODS
=over 4
=item new()
Constructor. Calls _initialize().
=item login( $username, $password )
Log into E2. Sets and return the cookie if successful, otherwise
returns undef.
=item get_all()
Get the xml chatterbox and private messages. Returns an array
whose first element is a reference to the chatter array and whose
second element is a reference to the private messages array.
=item send_message( $message [, @ids_to_delete] )
Send $message to the chatterbox. Returns undef on failure
and 1 on success. cookie() needs to be set beforehand.
If passed a list of message_id's from private messages
then try to delete them.
=back
=head1 PRIVATE METHODS
=over 4
=item _initialize()
Sets up the E2Chatterbox2 object by setting up 1) the user-agent,
2) the HTTP cookie jar, 3) the HTTP::Request for the chatterbox
xml ticker, 4) the parser for the chatterbox, 5) the last time for
the chatterbox, 6) the HTTP::Request for personal messages and
7) the parser for personal messages.
=item _dump_chatter()
Dump the data in chatter() to STDOUT.
=item _dump_msg()
Dump the data in msg() to STDOUT.
=item _get_chatter()
Make a request to get the chatterbox xml ticker. Return undef on
failure, the xml received on success.
=item _get_msg()
Get the messages from the 'private message XML ticker' node.
Return undef on failure, xml received on success.
=item _parse_chatter( [$xml] )
Parse chatter xml. NOTE: this is returns undef on success and the
error message on failure. Will update chatter() and chatter_time()
on success. If $xml is not passed, use chatter_data().
=item _parse_msg( [$xml] )
Parse private message xml. Just like _parse_chatter() this will
return undef on success and the error message on failure. Updates
msg() on success. Will use msg_data() if $xml isn't passed.
=back
=head1 DATA
=over 4
=item ua
The LWP::UserAgent object for E2Chatterbox2.
=item cookie
The cookie if the E2Chatterbox2 is logged in. Otherwise it's undef.
=item chatter
An reference to an array of references to arrays.
The chatter is in [ time, speaker, speech ].
=item chatter_parser
The XML::Parser for chatter.
=item chatter_data
The latest chatterbox data gotten.
=item chatter_req
The HTTP::Request to get the chatterbox.
=item chatter_time
The last message time seen from the chatterbox.
=item msg
Another reference to an array of references. These are
the private messages in [time, speaker, speech, message_id] form.
=item msg_parser
XML::Parser for private messages.
=item msg_data
Latest private message data gotten by the ua.
=item msg_req
HTTP::Request to get the private message xml ticker.
=back
=cut