1package BBS::UserInfo::Maple3itoc;
2
3use warnings;
4use strict;
5
6use Carp;
7use Expect;
8
9=head1 NAME
10
11BBS::UserInfo::Maple3itoc - Get user information of Maple3itoc-style BBS
12
13=cut
14
15our $VERSION = '0.01';
16
17=head1 SYNOPSIS
18
19    use BBS::UserInfo::Maple3itoc;
20
21    my $foo = BBS::UserInfo::Maple3itoc->new(
22	    'debug' => 1,
23	    'port' => 23,
24	    'server' => 'kulu.twbbs.org',
25	    'telnet' => '/usr/bin/telnet',
26	    'timeout' => 10
27	    );
28
29    # connect to the server
30    $bot->connect() or die('Unable to connect BBS');
31
32    my $userdata = $bot->query('username');
33
34    # print some data
35    print($userdata->{'logintimes'});
36
37=head1 FUNCTIONS
38
39=head2 new()
40
41Create a BBS::UserInfo::Maple3itoc object, there are some parameters
42that you can define:
43
44    server => 'kulu.twbbs.org'	# Necessary, server name
45    port => 23			# Optional, server port
46    telnet => 'telnet'		# Optional, telnet program
47    timeout => 10		# Optional, Expect timeout
48    debug => 1			# Optional, print debug information
49
50=cut
51
52sub new {
53    my ($class, %params) = @_;
54
55    my %self = (
56	'debug' => 0,
57	'password' => '',	# incomplete function
58	'port' => 23,
59	'server' => undef,
60	'telnet' => 'telnet',
61	'timeout' => 10,
62	'username' => 'guest'	# incomplete function
63    );
64
65    while (my ($k, $v) = each(%params)) {
66	$self{$k} = $v if (exists $self{$k});
67    }
68
69    return bless(\%self, $class);
70}
71
72=head2 connect()
73
74Connect to the BBS server.
75
76=cut
77
78sub connect {
79    my $self = shift();
80
81    $self->{'expect'} = Expect->spawn($self->{'telnet'}, $self->{'server'},
82	$self->{'port'});
83    $self->{'expect'}->log_stdout(0);
84
85    return undef unless (defined($self->_login($self)));
86
87    return $self->{'expect'};
88}
89
90sub _login {
91    my $self = shift();
92
93    my $bot = $self->{'expect'};
94    my $debug = $self->{'debug'};
95
96    print("Waiting for login\n") if ($debug);
97    $bot->expect($self->{'timeout'}, '-re', '�z���b��');
98    return undef if ($bot->error());
99
100    $bot->send($self->{'username'}, "\n");
101    return 1;
102}
103
104=head2 query()
105
106Query user information and return a hash reference with:
107
108=over 4
109
110=item * nickname
111
112=item * logintimes
113
114=item * posttimes
115
116=item * lastlogintime
117
118=item * lastloginip
119
120=back
121
122=cut
123
124sub query {
125    my ($self, $user) = @_;
126
127    my $bot = $self->{'expect'};
128    my $debug = $self->{'debug'};
129    my $timeout = $self->{'timeout'};
130
131    $bot->send("t\nq\n", $user, "\n");
132
133    my %h;
134
135    print("Waiting for nickname, logintimes, and posttimes\n") if ($debug);
136    $bot->expect($timeout, '-re', '\[�ʺ�\]\s(.+?)\s+\[�W��\]\s*(\d+)\s*��\s*\[�峹\]\s*?(\d+)\s*�g');
137    $h{'nickname'} = ($bot->matchlist)[0];
138    $h{'logintimes'} = ($bot->matchlist)[1];
139    $h{'posttimes'} = ($bot->matchlist)[2];
140    printf("nickname = %s\n", $h{'nickname'}) if ($debug);
141    printf("logintimes = %s\n", $h{'logintimes'}) if ($debug);
142    printf("posttimes = %s\n", $h{'posttimes'}) if ($debug);
143    return undef if ($bot->error());
144
145    print("Waiting for lastelogintime and lastloginip\n") if ($debug);
146    $bot->expect($timeout, '-re', '\[�ӷ�\]\s\((.+)\)\s([^ ]+)');
147    $h{'lastlogintime'} = ($bot->matchlist)[0];
148    $h{'lastloginip'} = ($bot->matchlist)[1];
149    printf("lastlogintime = %s\n", $h{'lastlogintime'}) if ($debug);
150    printf("lastloginip = %s\n", $h{'lastloginip'}) if ($debug);
151    return undef if ($bot->error());
152
153    return \%h;
154}
155
156=head1 AUTHOR
157
158Gea-Suan Lin, C<< <gslin at gslin.org> >>
159
160=head1 COPYRIGHT & LICENSE
161
162Copyright 2006 Gea-Suan Lin, all rights reserved.
163
164This program is free software; you can redistribute it and/or modify it
165under the same terms as Perl itself.
166
167=cut
168
1691; # End of BBS::UserInfo::Maple3itoc
170