package BBS::UserInfo::Maple3itoc; use warnings; use strict; use Carp; use Expect; =head1 NAME BBS::UserInfo::Maple3itoc - Get user information of Maple3itoc-style BBS =cut our $VERSION = '0.01'; =head1 SYNOPSIS use BBS::UserInfo::Maple3itoc; my $foo = BBS::UserInfo::Maple3itoc->new( 'debug' => 1, 'port' => 23, 'server' => 'kulu.twbbs.org', 'telnet' => '/usr/bin/telnet', 'timeout' => 10 ); # connect to the server $bot->connect() or die('Unable to connect BBS'); my $userdata = $bot->query('username'); # print some data print($userdata->{'logintimes'}); =head1 FUNCTIONS =head2 new() Create a BBS::UserInfo::Maple3itoc object, there are some parameters that you can define: server => 'kulu.twbbs.org' # Necessary, server name port => 23 # Optional, server port telnet => 'telnet' # Optional, telnet program timeout => 10 # Optional, Expect timeout debug => 1 # Optional, print debug information =cut sub new { my ($class, %params) = @_; my %self = ( 'debug' => 0, 'password' => '', # incomplete function 'port' => 23, 'server' => undef, 'telnet' => 'telnet', 'timeout' => 10, 'username' => 'guest' # incomplete function ); while (my ($k, $v) = each(%params)) { $self{$k} = $v if (exists $self{$k}); } return bless(\%self, $class); } =head2 connect() Connect to the BBS server. =cut sub connect { my $self = shift(); $self->{'expect'} = Expect->spawn($self->{'telnet'}, $self->{'server'}, $self->{'port'}); $self->{'expect'}->log_stdout(0); return undef unless (defined($self->_login($self))); return $self->{'expect'}; } sub _login { my $self = shift(); my $bot = $self->{'expect'}; my $debug = $self->{'debug'}; print("Waiting for login\n") if ($debug); $bot->expect($self->{'timeout'}, '-re', '您的帳號'); return undef if ($bot->error()); $bot->send($self->{'username'}, "\n"); return 1; } =head2 query() Query user information and return a hash reference with: =over 4 =item * nickname =item * logintimes =item * posttimes =item * lastlogintime =item * lastloginip =back =cut sub query { my ($self, $user) = @_; my $bot = $self->{'expect'}; my $debug = $self->{'debug'}; my $timeout = $self->{'timeout'}; $bot->send("t\nq\n", $user, "\n"); my %h; print("Waiting for nickname, logintimes, and posttimes\n") if ($debug); $bot->expect($timeout, '-re', '\[暱稱\]\s(.+?)\s+\[上站\]\s*(\d+)\s*次\s*\[文章\]\s*?(\d+)\s*篇'); $h{'nickname'} = ($bot->matchlist)[0]; $h{'logintimes'} = ($bot->matchlist)[1]; $h{'posttimes'} = ($bot->matchlist)[2]; printf("nickname = %s\n", $h{'nickname'}) if ($debug); printf("logintimes = %s\n", $h{'logintimes'}) if ($debug); printf("posttimes = %s\n", $h{'posttimes'}) if ($debug); return undef if ($bot->error()); print("Waiting for lastelogintime and lastloginip\n") if ($debug); $bot->expect($timeout, '-re', '\[來源\]\s\((.+)\)\s([^ ]+)'); $h{'lastlogintime'} = ($bot->matchlist)[0]; $h{'lastloginip'} = ($bot->matchlist)[1]; printf("lastlogintime = %s\n", $h{'lastlogintime'}) if ($debug); printf("lastloginip = %s\n", $h{'lastloginip'}) if ($debug); return undef if ($bot->error()); return \%h; } =head1 AUTHOR Gea-Suan Lin, C<< >> =head1 COPYRIGHT & LICENSE Copyright 2006 Gea-Suan Lin, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; # End of BBS::UserInfo::Maple3itoc