BBS::UserInfo::SOB - Get user information of SOB-style BBS


BBS-UserInfo-SOB documentation Contained in the BBS-UserInfo-SOB distribution.

Index


Code Index:

NAME

Top

BBS::UserInfo::SOB - Get user information of SOB-style BBS

SYNOPSIS

Top

    use BBS::UserInfo::SOB;

    my $foo = BBS::UserInfo::SOB->new(
	    'debug' => 1,
	    'port' => 23,
	    'server' => 'birdnest.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'});

FUNCTIONS

Top

new()

Create a BBS::UserInfo::SOB object, there are some parameters that you can define:

    server => 'birdnest.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

connect()

Connect to the BBS server.

query()

Query user information and return a hash reference with:

* nickname
* logintimes
* posttimes
* lastlogintime
* lastloginip

AUTHOR

Top

Gea-Suan Lin, <gslin at gslin.org>

COPYRIGHT & LICENSE

Top


BBS-UserInfo-SOB documentation Contained in the BBS-UserInfo-SOB distribution.
package BBS::UserInfo::SOB;

use warnings;
use strict;

use Carp;
use Expect;

our $VERSION = '0.01';

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);
}

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', '½Ð¿é¤J¥N¸¹');
    return undef if ($bot->error());

    $bot->send($self->{'username'}, "\n");
    return 1;
}

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', '\w+\((.*)\)\s?¦@¤W¯¸\s?(\d+)\s?¦¸¡Aµoªí¹L\s?(\d+)\s?½g¤å³¹');
    $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', '³Ìªñ\((.+)\)±q\[(\S+)\]¤W¯¸');
    $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;
}

1; # End of BBS::UserInfo::SOB