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[D[D[D[D"); 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("[D[Dt\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