File Coverage

blib/lib/Net/DirectConnect/clicli.pm
Criterion Covered Total %
statement 15 112 13.3
branch 0 68 0.0
condition 0 31 0.0
subroutine 5 29 17.2
pod 0 1 0.0
total 20 241 8.3


line stmt bran cond sub pod time code
1             #$Id: clicli.pm 919 2011-10-21 21:57:00Z pro $ $URL: svn://svn.setun.net/dcppp/trunk/lib/Net/DirectConnect/clicli.pm $
2             package #hide from cpan
3             Net::DirectConnect::clicli;
4 1     1   5 use strict;
  1         2  
  1         24  
5 1     1   4 use Net::DirectConnect;
  1         2  
  1         15  
6 1     1   4 use Data::Dumper; #dev only
  1         1  
  1         43  
7             $Data::Dumper::Sortkeys = 1;
8 1     1   4 no warnings qw(uninitialized);
  1         1  
  1         48  
9             our $VERSION = ( split( ' ', '$Revision: 919 $' ) )[1];
10 1     1   4 use base 'Net::DirectConnect';
  1         1  
  1         1373  
11              
12             sub init {
13 0     0 0   my $self = shift;
14             #$self->log($self, 'inited0',"MT:$self->{'message_type'}", ' with', Dumper \@_);
15 0           local %_ = (
16             #http://www.dcpp.net/wiki/index.php/%24Supports
17             'supports_avail' => [ qw(
18             BZList
19             MiniSlots
20             GetZBlock
21             XmlBZList
22             ADCGet
23             TTHL
24             TTHF
25             ZLIG
26             ClientID
27             CHUNK
28             GetTestZBlock
29             GetCID
30             )
31             ],
32             'XmlBZList' => 1,
33             'ADCGet' => 1,
34             'MiniSlots' => 1,
35             'TTHF' => 1,
36             #MiniSlots XmlBZList ADCGet TTHL TTHF
37             #@_,
38             'direction' => 'Download',
39             #'Direction' => 'Upload', #rand here
40             'incomingclass' => __PACKAGE__, 'reconnects' => 0, inactive_timeout => 60,
41             #charset_protocol => 'cp1251', #'utf8'
42             );
43             #$self->{$_} ||= $_{$_} for keys %_;
44             #!exists $self->{$_} ? $self->{$_} ||= $_{$_} : () for keys %_;
45 0   0       $self->{$_} //= $_{$_} for keys %_;
46 0           $self->{'modules'}{'nmdc'} = 1;
47 0 0 0       $self->{'auto_connect'} = 1 if !$self->{'incoming'} and !defined $self->{'auto_connect'};
48             #$self->log($self, 'inited1',"MT:$self->{'message_type'}", ' with', Dumper \@_);
49             #$self->log('dev', 'chPROTOcc:',$self->{'charset_protocol'});
50             #$self->baseinit();
51             #$self->log($self, 'inited2',"MT:$self->{'message_type'}", ' with', Dumper \@_);
52 0           $self->get_peer_addr();
53             #$self->log('info', "[$self->{'number'}] Incoming client $self->{'peerip'}") if $self->{'peerip'};
54             #$self->{'share_tth'} ||=$self->{'parent'}{'share_tth'};
55             #$self->{'share_full'} ||=$self->{'parent'}{'share_tth'};
56             #share_full share_tth want
57 0   0       $self->{$_} ||= $self->{'parent'}{$_} ||= {} for qw( NickList IpList PortList PortList_udp); #handler
      0        
58 0   0       $self->{$_} ||= $self->{'parent'}{$_} for qw( Nick );
59             #$self->{'NickList'} ||= {};
60             #$self->{'IpList'} ||= {};
61 0           $self->module_load('filelist');
62             #$self->{'PortList'} ||= {};
63             #$self->log( 'info', "Incoming client $self->{'host'}:$self->{'port'} via ", ref $self ) if $self->{'incoming'};
64             #$self->{'parse'} = undef if $self->{'parse'} and !keys %{ $self->{'parse'} };
65             #$self->{'parse'} ||= {
66             local %_ = (
67             'Lock' => sub {
68 0 0   0     my $self = shift if ref $_[0];
69             #$self->log('dev', 'LOCK:incoming', $self->{'incoming'});
70 0 0         if ( $self->{'incoming'} ) {
71 0           $self->{'sendbuf'} = 1;
72 0           $self->cmd('MyNick');
73             #$self->{'sendbuf'} = 0;
74 0           $self->cmd('Lock');
75             #$self->{'sendbuf'} = 1;
76 0           $self->cmd('Supports');
77 0           $self->cmd('Direction');
78 0           $self->{'sendbuf'} = 0;
79             #}
80             #my ($lock) = $_[0] =~ /^(.+?)(\s+Pk=.+)?\s*$/is;
81             #$_[0] =~ /^(.+?)(\s+Pk=.+)?\s*$/is;
82             #$self->cmd( 'Key', $self->lock2key($lock) );
83             } else {
84             #$_[0] =~ /^(.+?)(\s+Pk=.+)?\s*$/is;
85             #$self->{'key'} = $self->lock2key($1);
86             #$self->log ( 'dev','lock2key', "[$1]=[$self->{'key'}]");
87             }
88             #my ($lock)
89 0           ( $self->{'key'} ) = $_[0] =~ /^(.+?)(\s+Pk=.+)?\s*$/is;
90             #$_[0] =~ /^(.+?)(\s+Pk=.+)?\s*$/is;
91             #$self->log('dev', 'keycmd', $self->{'key'},$self->{'incoming'});
92 0 0         $self->cmd( 'Key', $self->{'key'} ) if ( $self->{'incoming'} );
93             },
94             'Direction' => sub {
95 0 0   0     my $self = shift if ref $_[0];
96 0           my $d = ( split /\s/, $_[0] )[0];
97 0 0         if ( $d eq 'Download' ) { $self->{'direction'} = 'Upload'; }
  0            
98             else {
99 0           $self->{'direction'} = 'Download';
100             #$self->log ( 'dev', "direction UNKNOWN [$d]", $self->{'direction'}, 'from', @_, ';');
101             }
102             #$self->log ( 'dev', "direction RECIEVED", $self->{'direction'}, 'from', @_, ';');
103             #2009/11/04-02:08:20 dev [2] direction RECIEVED Download from Download 28048 ;
104             },
105             'Key' => sub {
106 0 0   0     my $self = shift if ref $_[0];
107 0 0         if ( $self->{'incoming'} ) { }
108             else {
109             #$self->log('dev', 'outk',);
110 0           $self->{'sendbuf'} = 1;
111 0           $self->cmd('Supports');
112 0           $self->cmd('Direction');
113 0           $self->{'sendbuf'} = 0;
114 0           $self->cmd( 'Key', $self->{'key'} );
115             }
116 0 0         $self->file_select(), $self->log( "get:[filename:", $self->{'filename'}, '; fileas:', $self->{'fileas'}, "]" )
117             if $self->{'direction'} eq 'Download';
118 0 0 0       $self->{'get'} = $self->{'filename'} . '$' . ( $self->{'file_recv_from'} || 1 ),
    0 0        
      0        
119             $self->{'adcget'} =
120             'file ' . $self->{'filename'} . ' ' . ( $self->{'file_recv_from'} || 0 ) . ' ' . ( $self->{'file_recv_to'} || '-1' ),
121             $self->cmd( ( $self->{'NickList'}->{ $self->{'peernick'} }{'ADCGet'} ? 'ADCGET' : 'Get' ) )
122             if $self->{'filename'};
123             },
124             'Get' => sub {
125 0 0   0     my $self = shift if ref $_[0];
126             #TODO
127 0           $self->cmd( 'FileLength', 0 );
128             },
129             'MyNick' => sub {
130 0 0   0     my $self = shift if ref $_[0];
131 0           $self->log( 'info', "peer is [", ( $self->{'peernick'} = $_[0] ), "]" );
132 0           $self->{'NickList'}->{ $self->{'peernick'} }{'ip'} = $self->{'host'};
133 0           $self->{'NickList'}->{ $self->{'peernick'} }{'port'} = $self->{'port'};
134 0           $self->{'IpList'}->{ $self->{'host'} } = \%{ $self->{'NickList'}->{ $self->{'peernick'} } };
  0            
135 0           $self->{'IpList'}->{ $self->{'host'} }->{'port'} = $self->{'PortList'}->{ $self->{'host'} };
136 0           $self->handler( 'user_ip', $self->{'peernick'}, $self->{'host'}, $self->{'port'} );
137 0 0         if ( keys %{ $self->{'want'}->{ $self->{'peernick'} } } ) { $self->{'direction'} = 'Download'; }
  0            
  0            
138 0           else { $self->{'direction'} = 'Upload'; }
139             #$self->log ( 'dev', "direction", $self->{'direction'}, 'from', keys %{ $self->{'want'}->{ $self->{'peernick'} } }, ';');
140             },
141             'FileLength' => sub {
142 0 0   0     my $self = shift if ref $_[0];
143 0           $self->{'filetotal'} = $_[0];
144 0 0         return if $self->file_open();
145 0           $self->cmd('Send');
146             },
147             'ADCSND' => sub {
148 0 0   0     my $self = shift if ref $_[0];
149             #$self->log( 'dev', "ADCSND::", @_ );
150             #$_[0] =~ /(\d+?)$/is;
151 0           local @_ = split /\s+/, $_[0];
152 0           $self->{'filetotal'} = $_[2] + $_[3];
153 0           return $self->file_open();
154             },
155             'CSND' => sub {
156 0 0   0     my $self = shift if ref $_[0];
157 0           $_[0] =~ /^file\s+\S+\s+(\d+)\s(\d+)$/is;
158 0           $self->{'filetotal'} = $1 + $2;
159 0           return $self->file_open();
160             },
161             'Supports' => sub {
162 0 0   0     my $self = shift if ref $_[0];
163 0           $self->supports_parse( $_[0], $self->{'NickList'}->{ $self->{'peernick'} } );
164             },
165             'MaxedOut' => sub {
166 0 0   0     my $self = shift if ref $_[0];
167 0           $self->disconnect();
168             },
169             'ADCGET' => sub {
170 0 0   0     my $self = shift if ref $_[0];
171             #$self->log('dev', 'ADCGET', @_);
172 0 0         $self->cmd( 'Error', "File Not Available" ) if $self->file_send_parse( map { split /\s/, $_ } @_ );
  0            
173             },
174             #};
175 0           );
176 0   0       $self->{'parse'}{$_} ||= $_{$_} for keys %_;
177             #$self->log ( 'dev', "del empty cmd", ),
178             #$self->{'cmd'} = undef if $self->{'cmd'} and !keys %{ $self->{'cmd'} };
179             #$self->log('PRECMD',Dumper $self->{'cmd'});
180             #$self->{'cmd'} ||= {
181             local %_ = (
182             'connect_aft' => sub {
183 0 0   0     my $self = shift if ref $_[0];
184             #my $self = shift if ref $_[0];
185 0           $self->{'sendbuf'} = 1;
186 0           $self->cmd('MyNick');
187 0           $self->{'sendbuf'} = 0;
188 0           $self->cmd('Lock');
189             },
190             'MyNick' => sub {
191 0 0   0     my $self = shift if ref $_[0];
192 0           $self->sendcmd(
193             'MyNick', $self->{'Nick'} #|| $self->{'parent'}{'Nick'}
194             );
195             },
196             'Lock' => sub {
197 0 0   0     my $self = shift if ref $_[0];
198             #$self->log('dev', 'cmdLOCK', $_[0],$self->{'lock'});
199 0   0       $self->sendcmd( 'Lock', $_[0] || $self->{'lock'} );
200             },
201             'Supports' => sub {
202 0 0   0     my $self = shift if ref $_[0];
203 0   0       $self->sendcmd( 'Supports', $self->supports() || 'MiniSlots XmlBZList ADCGet TTHF' ); #TTHL
204             },
205             'Direction' => sub {
206 0 0   0     my $self = shift if ref $_[0];
207 0           $self->sendcmd( 'Direction', $self->{'direction'}, int( rand(0x7FFF) ) );
208             },
209             'Key' => sub {
210 0 0   0     my $self = shift if ref $_[0];
211             #$self->log('dev', 'cmdKEY', $_[0],$self->{'incoming'});
212 0           $self->sendcmd( 'Key', $_[0] );
213             },
214             'Get' => sub {
215 0 0   0     my $self = shift if ref $_[0];
216 0           $self->sendcmd( 'Get', $self->{'get'} );
217             },
218             'Send' => sub {
219 0 0   0     my $self = shift if ref $_[0];
220 0           $self->sendcmd('Send');
221             },
222             'FileLength' => sub {
223 0 0   0     my $self = shift if ref $_[0];
224 0           $self->sendcmd( 'FileLength', $_[0] );
225             },
226             'ADCGET' => sub {
227 0 0   0     my $self = shift if ref $_[0];
228             #$ADCGET file TTH/I2VAVWYGSVTBHSKN3BOA6EWTXSP4GAKJMRK2DJQ 730020132 2586332
229 0           $self->sendcmd( 'ADCGET', $self->{'adcget'} );
230             },
231             'ADCSND' => sub {
232 0 0   0     my $self = shift if ref $_[0];
233 0           $self->sendcmd( 'ADCSND', @_ );
234             },
235             'Error' => sub {
236 0 0   0     my $self = shift if ref $_[0];
237 0           $self->sendcmd( 'Error', $_[0] );
238             },
239 0           );
240 0   0       $self->{'cmd'}{$_} ||= $_{$_} for keys %_;
241             }
242             1;