1 |
joko |
1.1 |
#!/usr/bin/perl -w |
2 |
|
|
|
3 |
|
|
# PoCo-giFT v0.1 Jason Stillwell 2002 |
4 |
|
|
# use at your own risk, no warantees implied, no guarantees provided. |
5 |
|
|
# it shouldn't \rm -rf * your hard drive but then again look what happened with Pool of Radiance |
6 |
|
|
|
7 |
|
|
use strict; |
8 |
|
|
use Gtk; |
9 |
|
|
use POE; |
10 |
|
|
|
11 |
|
|
package POE::Component::giFT; |
12 |
|
|
use POE::Session; |
13 |
|
|
use POE::Wheel::SocketFactory; |
14 |
|
|
use POE::Wheel::ReadWrite; |
15 |
|
|
use POE::Driver::SysRW; |
16 |
|
|
use POE::Filter::Stream; |
17 |
|
|
use Gtk; |
18 |
|
|
use Data::Dumper; |
19 |
|
|
|
20 |
|
|
my $LOG; # later, the logging method to use. |
21 |
|
|
|
22 |
|
|
sub new { # CLASS METHOD |
23 |
|
|
my $type = shift; |
24 |
|
|
my %options = @_; |
25 |
|
|
|
26 |
|
|
$LOG = $options{LOG} if exists($options{LOG}); |
27 |
|
|
|
28 |
|
|
# start up gift POE session |
29 |
|
|
my $session = POE::Session->create( |
30 |
|
|
package_states => [ |
31 |
|
|
$type => |
32 |
|
|
[ qw( |
33 |
|
|
_start |
34 |
|
|
gtk_start |
35 |
|
|
connect_success |
36 |
|
|
connect_failure |
37 |
|
|
io_error |
38 |
|
|
io_input |
39 |
|
|
close |
40 |
|
|
do_query |
41 |
|
|
do_transfer |
42 |
|
|
add_sources |
43 |
|
|
event_in |
44 |
|
|
item_in |
45 |
|
|
id_in |
46 |
|
|
end_id |
47 |
|
|
query_clicked |
48 |
|
|
download_clicked |
49 |
|
|
stop_download_clicked |
50 |
|
|
stop_upload_clicked |
51 |
|
|
get_stats |
52 |
|
|
) ] |
53 |
|
|
], |
54 |
|
|
options => { debug => 1 } |
55 |
|
|
); |
56 |
|
|
|
57 |
|
|
return $session; |
58 |
|
|
} |
59 |
|
|
|
60 |
|
|
sub connect_failure { # EVENT |
61 |
|
|
# called if we can't connect to the daemon |
62 |
|
|
my $kernel = $_[KERNEL]; |
63 |
|
|
&log("daemon connect failed"); |
64 |
|
|
$kernel->yield('close'); |
65 |
|
|
} |
66 |
|
|
|
67 |
|
|
sub close { # EVENT |
68 |
|
|
# called if the connection closed or we need to close it |
69 |
|
|
my $heap = $_[HEAP]; |
70 |
|
|
&log("closing connection"); |
71 |
|
|
delete $heap->{factory}; |
72 |
|
|
delete $heap->{io}; |
73 |
|
|
} |
74 |
|
|
|
75 |
|
|
sub connect_success { # EVENT |
76 |
|
|
# called when our socket connects. does protocol initilization. |
77 |
|
|
my ($kernel,$heap,$socket) = @_[KERNEL,HEAP,ARG0]; |
78 |
|
|
|
79 |
|
|
&log("daemon connected, sending attach"); |
80 |
|
|
$heap->{io} = new POE::Wheel::ReadWrite ( |
81 |
|
|
Handle => $socket, |
82 |
|
|
Driver => new POE::Driver::SysRW (), |
83 |
|
|
Filter => new POE::Filter::Stream (), |
84 |
|
|
InputEvent => 'io_input', |
85 |
|
|
ErrorEvent => 'io_error' |
86 |
|
|
); |
87 |
|
|
|
88 |
|
|
$heap->{io}->put(&event_to_data({event=>'attach', profile=>'dragonfax', client=>'PoCo-giFT', version=>'0.1'})); |
89 |
|
|
$kernel->yield('gtk_start'); |
90 |
|
|
} |
91 |
|
|
|
92 |
|
|
|
93 |
|
|
# for simplicity we dont use a full fledged 'event' object. just a hash of values. |
94 |
|
|
# these two function handle the converstion to and from the io stream when necessary |
95 |
|
|
|
96 |
|
|
sub event_to_data { # SUBROUTINE |
97 |
|
|
my %event = %{shift()}; |
98 |
|
|
if ( not exists($event{event}) ) { |
99 |
|
|
&log('tried to create event without a type'); |
100 |
|
|
&print_event(\%event); |
101 |
|
|
return undef; |
102 |
|
|
} |
103 |
|
|
my $data = "<$event{event}"; |
104 |
|
|
foreach my $param ( keys %event ) { |
105 |
|
|
next if $param eq 'event'; |
106 |
|
|
$data .= qq( $param="$event{$param}"); |
107 |
|
|
} |
108 |
|
|
$data .= "/>\r\n"; |
109 |
|
|
return $data; |
110 |
|
|
} |
111 |
|
|
|
112 |
|
|
sub data_to_event { # SUBROUTINE |
113 |
|
|
# takes a line from the socket input and turns it into a hash ref of values |
114 |
|
|
my $data = shift; |
115 |
|
|
$data =~ s{\r\n$}{}; |
116 |
|
|
$data =~ s{^<(.+)/>$}{$1} or &log("bad event structure $data"); |
117 |
|
|
$data =~ s{^(\S+)\s*}{} or &log("no event type $data"); |
118 |
|
|
|
119 |
|
|
my %params = ( event => $1 ); |
120 |
|
|
while ( $data =~ s{^\s*(\S+)="([^"]+)"\s*}{} ) { |
121 |
|
|
$params{$1} = $2; |
122 |
|
|
} |
123 |
|
|
|
124 |
|
|
return \%params; |
125 |
|
|
} |
126 |
|
|
|
127 |
|
|
sub io_input { # EVENT |
128 |
|
|
# called when we receive input. breaks it up into lines and hands it over to the event dispatcher |
129 |
|
|
my ($kernel,$line) = @_[KERNEL,ARG0]; |
130 |
|
|
|
131 |
|
|
while ( $line =~ s{^(.+)\r\n}{} ) { # possibly multiple lines per io input packet |
132 |
|
|
my $tag = $1; |
133 |
|
|
my $event = &data_to_event($tag); |
134 |
|
|
$kernel->yield('event_in',$event); |
135 |
|
|
} |
136 |
|
|
} |
137 |
|
|
|
138 |
|
|
sub event_in { # EVENT |
139 |
|
|
# event dispatcher, receives lines, parses them and distributes them to the write events |
140 |
|
|
my ($kernel,$heap,$event) = @_[KERNEL,HEAP,ARG0]; |
141 |
|
|
#&print_event($event); |
142 |
|
|
|
143 |
|
|
if ( $$event{event} eq 'event' ) { |
144 |
|
|
# let ui know we've got an id now |
145 |
|
|
$kernel->yield('id_in',$event); |
146 |
|
|
} |
147 |
|
|
elsif ( $$event{event} eq 'item' ) { # query hit |
148 |
|
|
$kernel->yield('item_in',$event); |
149 |
|
|
} |
150 |
|
|
elsif ( $$event{event} eq 'search' ) { # query hit |
151 |
|
|
# let ui know this event is over |
152 |
|
|
$kernel->yield('end_id',$event); |
153 |
|
|
} |
154 |
|
|
elsif ( $$event{event} eq 'stats' ) { |
155 |
|
|
# update stats display, we only care about OpenFT for now |
156 |
|
|
return if ( not exists($$event{protocol}) ) or ( $$event{protocol} ne 'OpenFT' ); |
157 |
|
|
$heap->{labels}->{users}->set_text($$event{users}); |
158 |
|
|
$heap->{labels}->{files}->set_text($$event{files}); |
159 |
|
|
$heap->{labels}->{shared}->set_text("$$event{size}GB"); |
160 |
|
|
} |
161 |
|
|
elsif ( $$event{event} eq 'transfer' ) { |
162 |
|
|
# its either an upload, external download, or progress |
163 |
|
|
if ( exists($heap->{transfers}->{$$event{id}}) ) { |
164 |
|
|
if ( exists($$event{addsource}) ) { |
165 |
|
|
# just a source line, no data downloaded, add info |
166 |
|
|
push @{$heap->{transfers}->{$$event{id}}->{sources}},$event; |
167 |
|
|
} |
168 |
|
|
elsif ( exists($$event{transmit}) ) { |
169 |
|
|
# update line in CList (GUI) |
170 |
|
|
my $id = $$event{id}; |
171 |
|
|
my $list; |
172 |
|
|
my $number; |
173 |
|
|
if ( exists($heap->{transfers}->{$id}->{dl_number}) ) { |
174 |
|
|
$number = $heap->{transfers}->{$id}->{dl_number}; |
175 |
|
|
$list = $heap->{dl_list} |
176 |
|
|
} |
177 |
|
|
else { |
178 |
|
|
$number = $heap->{transfers}->{$id}->{ul_number}; |
179 |
|
|
$list = $heap->{ul_list}; |
180 |
|
|
} |
181 |
|
|
$list->set_text($number,1,$$event{transmit}); |
182 |
|
|
} |
183 |
|
|
else { |
184 |
|
|
# end-transfer event |
185 |
|
|
|
186 |
|
|
# remove line from clist |
187 |
|
|
my $id = $$event{id}; |
188 |
|
|
my $hash = $heap->{transfers}->{$id}->{hash}; |
189 |
|
|
my $list = exists($heap->{transfers}->{$id}->{dl_number}) ? $heap->{dl_list} : $heap->{ul_list}; |
190 |
|
|
# find row to remove (clist.find_row_from_dat is useless) |
191 |
|
|
my $num_rows = $list->rows(); |
192 |
|
|
for ( my $i = 0; $i < $num_rows; $i++) { |
193 |
|
|
if ( $list->get_text($i,3) eq $hash ) { |
194 |
|
|
$list->remove($i); |
195 |
|
|
last; |
196 |
|
|
} |
197 |
|
|
} |
198 |
|
|
|
199 |
|
|
# remove transfer info |
200 |
|
|
delete($heap->{transfers}->{$id}); |
201 |
|
|
} |
202 |
|
|
} |
203 |
|
|
elsif ( exists($$event{action}) ) { |
204 |
|
|
# upload started or downloaded started in a different session (gui) |
205 |
|
|
$heap->{transfers}->{$$event{id}} = $event; |
206 |
|
|
if ( $$event{action} eq 'upload' ) { |
207 |
|
|
# upload notification |
208 |
|
|
my $number = $heap->{ul_list}->rows(); |
209 |
|
|
$heap->{transfers}->{$$event{id}}->{ul_number} = $number; |
210 |
|
|
$heap->{ul_list}->append($$event{save}, 0, $$event{size}, $$event{hash}); |
211 |
|
|
} |
212 |
|
|
elsif ( $$event{action} eq 'download' ) { |
213 |
|
|
# new transfer, create the stuff to watch it. |
214 |
|
|
my $number = $heap->{dl_list}->rows(); |
215 |
|
|
$heap->{transfers}->{$$event{id}}->{dl_number} = $number; |
216 |
|
|
$heap->{dl_list}->append($$event{save}, 0, $$event{size}, $$event{hash}); |
217 |
|
|
|
218 |
|
|
} |
219 |
|
|
} |
220 |
|
|
} |
221 |
|
|
#else { |
222 |
|
|
#} |
223 |
|
|
|
224 |
|
|
} |
225 |
|
|
|
226 |
|
|
sub stop_download_clicked { # EVENT |
227 |
|
|
# kill download clicked in GUI |
228 |
|
|
my ($heap) = $_[HEAP]; |
229 |
|
|
my $list = $heap->{dl_list}; |
230 |
|
|
&stop_transfer($heap,$list); |
231 |
|
|
} |
232 |
|
|
|
233 |
|
|
sub stop_upload_clicked { # SUBROUTINE |
234 |
|
|
# kill upload clicked in GUI |
235 |
|
|
my ($heap) = $_[HEAP]; |
236 |
|
|
my $list = $heap->{ul_list}; |
237 |
|
|
&stop_transfer($heap,$list); |
238 |
|
|
} |
239 |
|
|
|
240 |
|
|
sub stop_transfer { # EVENT |
241 |
|
|
# kills the transfer and removes it from our internal structs and GUI |
242 |
|
|
my ($heap,$list) = @_; |
243 |
|
|
my $row_selected = ($list->selection)[0]; |
244 |
|
|
my $hash = $list->get_text($row_selected,3); |
245 |
|
|
|
246 |
|
|
# find that id |
247 |
|
|
my $our_id; |
248 |
|
|
foreach my $id ( keys %{$heap->{transfers}} ) { |
249 |
|
|
$our_id = $id if $heap->{transfers}->{$id}->{hash} eq $hash; |
250 |
|
|
} |
251 |
|
|
|
252 |
|
|
# send 'kill transfer' |
253 |
|
|
$heap->{io}->put(&event_to_data({event=>'transfer', action=>'cancel', id=>$our_id})); |
254 |
|
|
|
255 |
|
|
} |
256 |
|
|
|
257 |
|
|
|
258 |
|
|
sub get_stats { # EVENT |
259 |
|
|
# politely asks for stats update |
260 |
|
|
my $heap = $_[HEAP]; |
261 |
|
|
$heap->{io}->put(&event_to_data({event=>'stats'})); |
262 |
|
|
$heap->{waiting} = { event => 'stats'}; |
263 |
|
|
} |
264 |
|
|
|
265 |
|
|
sub do_query { # EVENT |
266 |
|
|
# handles the underlying part of sending a query to the daemon |
267 |
|
|
my ($heap,$query,$realm) = @_[HEAP,ARG0,ARG1]; |
268 |
|
|
if ( $realm eq 'everything' ) { |
269 |
|
|
$heap->{io}->put(&event_to_data({event=>'search', query=>$query})); |
270 |
|
|
} |
271 |
|
|
else { |
272 |
|
|
$heap->{io}->put(&event_to_data({event=>'search', realm=>$realm, query=>$query})); |
273 |
|
|
} |
274 |
|
|
} |
275 |
|
|
|
276 |
|
|
sub do_transfer { # EVENT |
277 |
|
|
# handles hte underlying protocol of sending a transfer request to the daemon |
278 |
|
|
my ($heap,$hash) = @_[HEAP,ARG0]; |
279 |
|
|
my $filename = &href2filename($heap->{hashes}->{$hash}->[0]->{href}); |
280 |
|
|
my $size = $heap->{hashes}->{$hash}->[0]->{size}; |
281 |
|
|
$heap->{io}->put(&event_to_data({event=>'transfer', action=>'download', save=>$filename, size=>$size, hash=>$hash})); |
282 |
|
|
} |
283 |
|
|
|
284 |
|
|
sub print_event { # SUBROUTINE |
285 |
|
|
# useful for logging purposes |
286 |
|
|
my $event = shift; |
287 |
|
|
my $string = "[$$event{event}]"; |
288 |
|
|
foreach my $param ( keys %{$event} ) { |
289 |
|
|
next if ($param eq 'event'); |
290 |
|
|
$string .= " $param=$$event{$param}"; |
291 |
|
|
} |
292 |
|
|
&log($string); |
293 |
|
|
} |
294 |
|
|
|
295 |
|
|
sub io_error { # EVENT |
296 |
|
|
# called when we fail to read from the socket. means its time to close up shop. |
297 |
|
|
my $kernel = $_[KERNEL]; |
298 |
|
|
&log("io error"); |
299 |
|
|
$kernel->yield('close'); |
300 |
|
|
} |
301 |
|
|
|
302 |
|
|
|
303 |
|
|
|
304 |
|
|
sub _start { # EVENT |
305 |
|
|
# session initializer, like a Constructor but for POE sessions. |
306 |
|
|
my ($kernel,$heap) = @_[KERNEL,HEAP]; |
307 |
|
|
|
308 |
|
|
$kernel->alias_set('giFT'); |
309 |
|
|
$heap->{queries} = []; |
310 |
|
|
|
311 |
|
|
&log("connecting to daemon"); |
312 |
|
|
$heap->{factory} = new POE::Wheel::SocketFactory |
313 |
|
|
( |
314 |
|
|
RemoteAddress => '127.0.0.1', # Sets the connect() address |
315 |
|
|
RemotePort => 1213, # Sets the connect() port |
316 |
|
|
SuccessEvent => 'connect_success', |
317 |
|
|
FailureEvent => 'connect_failure' |
318 |
|
|
); |
319 |
|
|
|
320 |
|
|
} |
321 |
|
|
|
322 |
|
|
sub gtk_start { # EVENT |
323 |
|
|
# we've connected to the daemon so its OK to start the GUI. |
324 |
|
|
# this sets up almost the entire GUI and displays it. |
325 |
|
|
my ($kernel,$heap,$session) = @_[KERNEL,HEAP,SESSION]; |
326 |
|
|
|
327 |
|
|
set_locale Gtk; |
328 |
|
|
init Gtk; |
329 |
|
|
my $window = new Gtk::Window("toplevel"); |
330 |
|
|
$window->set_title('PoCo-giFT'); |
331 |
|
|
$window->signal_connect( "delete_event", sub {Gtk->main_quit} ); |
332 |
|
|
$window->border_width( 5 ); |
333 |
|
|
|
334 |
|
|
my $notebook = new Gtk::Notebook(); |
335 |
|
|
$notebook->set_tab_pos('top'); |
336 |
|
|
$window->add($notebook); |
337 |
|
|
|
338 |
|
|
### |
339 |
|
|
# Search Tab |
340 |
|
|
### |
341 |
|
|
|
342 |
|
|
my $search_table = new Gtk::Table( 5, 3, 0 ); |
343 |
|
|
$heap->{search_table} = $search_table; |
344 |
|
|
$search_table->set_row_spacings(10); |
345 |
|
|
$search_table->set_col_spacings(10); |
346 |
|
|
$notebook->append_page($search_table, Gtk::Label->new("Search")); |
347 |
|
|
|
348 |
|
|
my $search_label = new Gtk::Label('Keywords:'); |
349 |
|
|
my $entry = new Gtk::Entry(); |
350 |
|
|
$search_table->attach($search_label,0,1,0,1, [], [], 0, 0); |
351 |
|
|
|
352 |
|
|
$heap->{entry} = $entry; |
353 |
|
|
$entry->signal_connect("activate", $session->postback('query_clicked')); |
354 |
|
|
$search_table->attach($entry,1,2,0,1, [], [], 0, 0); |
355 |
|
|
|
356 |
|
|
my $realm_select = new Gtk::OptionMenu(); |
357 |
|
|
my $realm_menu = new Gtk::Menu(); |
358 |
|
|
$heap->{realm_menu} = $realm_menu; |
359 |
|
|
|
360 |
|
|
my $everything_item = new Gtk::MenuItem("Everything"); |
361 |
|
|
$realm_menu->append($everything_item); |
362 |
|
|
$everything_item->show(); |
363 |
|
|
$heap->{realms}->{$everything_item} = 'everything'; |
364 |
|
|
|
365 |
|
|
my $audio_item = new Gtk::MenuItem("Audio"); |
366 |
|
|
$realm_menu->append($audio_item); |
367 |
|
|
$audio_item->show(); |
368 |
|
|
$heap->{realms}->{$audio_item} = 'audio'; |
369 |
|
|
|
370 |
|
|
my $video_item = new Gtk::MenuItem("Video"); |
371 |
|
|
$realm_menu->append($video_item); |
372 |
|
|
$video_item->show(); |
373 |
|
|
$heap->{realms}->{$video_item} = 'video'; |
374 |
|
|
|
375 |
|
|
my $images_item = new Gtk::MenuItem("Images"); |
376 |
|
|
$realm_menu->append($images_item); |
377 |
|
|
$images_item->show(); |
378 |
|
|
$heap->{realms}->{$images_item} = 'images'; |
379 |
|
|
|
380 |
|
|
my $texts_item = new Gtk::MenuItem("Text Documents"); |
381 |
|
|
$realm_menu->append($texts_item); |
382 |
|
|
$texts_item->show(); |
383 |
|
|
$heap->{realms}->{$texts_item} = 'text documents'; |
384 |
|
|
|
385 |
|
|
my $software_item = new Gtk::MenuItem("Software"); |
386 |
|
|
$realm_menu->append($software_item); |
387 |
|
|
$software_item->show(); |
388 |
|
|
$heap->{realms}->{$software_item} = 'software'; |
389 |
|
|
|
390 |
|
|
my $hash_item = new Gtk::MenuItem("Hash"); |
391 |
|
|
$realm_menu->append($hash_item); |
392 |
|
|
$hash_item->show(); |
393 |
|
|
$heap->{realms}->{$hash_item} = 'hash'; |
394 |
|
|
|
395 |
|
|
my $user_item = new Gtk::MenuItem("User"); |
396 |
|
|
$realm_menu->append($user_item); |
397 |
|
|
$user_item->show(); |
398 |
|
|
$heap->{realms}->{$user_item} = 'user'; |
399 |
|
|
|
400 |
|
|
$realm_select->set_menu( $realm_menu); |
401 |
|
|
$realm_select->set_history( 0 ); |
402 |
|
|
$search_table->attach($realm_select,0,2,1,2, [], [], 0, 0); |
403 |
|
|
|
404 |
|
|
|
405 |
|
|
|
406 |
|
|
my $search_button = new Gtk::Button("Search"); |
407 |
|
|
$search_button->signal_connect("clicked", $session->postback('query_clicked')); |
408 |
|
|
$search_table->attach($search_button,0,1,2,3, [], [], 0, 0); |
409 |
|
|
|
410 |
|
|
my $close_query_button = new Gtk::Label("Close Query"); |
411 |
|
|
$search_table->attach($close_query_button,1,2,2,3, [], [], 0, 0); |
412 |
|
|
|
413 |
|
|
|
414 |
|
|
## Stats Table |
415 |
|
|
my $stats_table = new Gtk::Table( 3, 2, 1 ); |
416 |
|
|
$stats_table->attach_defaults(Gtk::Label->new("Users:"),0,1,0,1); |
417 |
|
|
$stats_table->attach_defaults(Gtk::Label->new("Files:"),0,1,1,2); |
418 |
|
|
$stats_table->attach_defaults(Gtk::Label->new("Shared:"),0,1,2,3); |
419 |
|
|
$search_table->attach($stats_table,2,3,0,3, [], [], 0, 0); |
420 |
|
|
|
421 |
|
|
my $users_label = Gtk::Label->new(0); |
422 |
|
|
$stats_table->attach_defaults($users_label,1,2,0,1); |
423 |
|
|
$heap->{labels}->{users} = $users_label; |
424 |
|
|
|
425 |
|
|
my $files_label = Gtk::Label->new(0); |
426 |
|
|
$stats_table->attach_defaults($files_label,1,2,1,2); |
427 |
|
|
$heap->{labels}->{files} = $files_label; |
428 |
|
|
|
429 |
|
|
my $shared_label = Gtk::Label->new(0); |
430 |
|
|
$stats_table->attach_defaults($shared_label,1,2,2,3); |
431 |
|
|
$heap->{labels}->{shared} = $shared_label; |
432 |
|
|
|
433 |
|
|
|
434 |
|
|
my $scrolled_window = new Gtk::ScrolledWindow( undef, undef ); |
435 |
|
|
$heap->{query_scrolls}->[0] = $scrolled_window; |
436 |
|
|
$scrolled_window->set_usize( 400, 300 ); |
437 |
|
|
$search_table->attach($scrolled_window,0,3,3,4,[qw(fill expand)], [qw(fill expand)], 0, 0 ); |
438 |
|
|
|
439 |
|
|
my $gtklist = Gtk::CList->new_with_titles(qw(name size hash)); |
440 |
|
|
$gtklist->set_selection_mode('single'); |
441 |
|
|
$gtklist->set_column_width(0,200); |
442 |
|
|
$gtklist->set_column_width(1,100); |
443 |
|
|
$heap->{lists}->[0] = $gtklist; |
444 |
|
|
$scrolled_window->add_with_viewport( $gtklist ); |
445 |
|
|
|
446 |
|
|
my $download_button = new Gtk::Button("Download"); |
447 |
|
|
$download_button->signal_connect("clicked", $session->postback('download_clicked')); |
448 |
|
|
$search_table->attach($download_button,1,2,4,5, [], [], 0, 0); |
449 |
|
|
|
450 |
|
|
my $quit_button = new Gtk::Button("Quit"); |
451 |
|
|
$quit_button->signal_connect("clicked", sub {Gtk->main_quit}); |
452 |
|
|
$search_table->attach($quit_button,2,3,4,5, [], [], 0, 0); |
453 |
|
|
|
454 |
|
|
### |
455 |
|
|
# Transfers Tab |
456 |
|
|
### |
457 |
|
|
my $paned = new Gtk::VPaned(); |
458 |
|
|
$notebook->append_page($paned, Gtk::Label->new("Transfers")); |
459 |
|
|
|
460 |
|
|
## Downloads |
461 |
|
|
|
462 |
|
|
my $downloads_box = new Gtk::VBox( 0, 5); |
463 |
|
|
$paned->add1($downloads_box); |
464 |
|
|
|
465 |
|
|
my $downloads_window = new Gtk::ScrolledWindow( undef, undef ); |
466 |
|
|
$downloads_box->pack_start($downloads_window, 1, 1, 0); |
467 |
|
|
|
468 |
|
|
my $dl_list = Gtk::CList->new_with_titles(qw(name dl total hash)); |
469 |
|
|
$dl_list->set_selection_mode('single'); |
470 |
|
|
$dl_list->set_column_width(0,200); |
471 |
|
|
$dl_list->set_column_width(1,100); |
472 |
|
|
$dl_list->set_column_width(2,100); |
473 |
|
|
$heap->{dl_list} = $dl_list; |
474 |
|
|
$downloads_window->add_with_viewport( $dl_list ); |
475 |
|
|
|
476 |
|
|
my $stop_download = new Gtk::Button("Kill Download"); |
477 |
|
|
$downloads_box->pack_start($stop_download, 0, 0, 0); |
478 |
|
|
$stop_download->signal_connect("clicked", $session->postback('stop_download_clicked')); |
479 |
|
|
|
480 |
|
|
|
481 |
|
|
## Uploads |
482 |
|
|
my $uploads_box = new Gtk::VBox( 0, 5); |
483 |
|
|
$paned->add2($uploads_box); |
484 |
|
|
|
485 |
|
|
my $uploads_window = new Gtk::ScrolledWindow( undef, undef ); |
486 |
|
|
$uploads_box->pack_start($uploads_window, 1, 1, 0); |
487 |
|
|
|
488 |
|
|
my $ul_list = Gtk::CList->new_with_titles(qw(name ul total hash)); |
489 |
|
|
$ul_list->set_selection_mode('single'); |
490 |
|
|
$ul_list->set_column_width(0,200); |
491 |
|
|
$ul_list->set_column_width(1,100); |
492 |
|
|
$ul_list->set_column_width(2,100); |
493 |
|
|
$heap->{ul_list} = $ul_list; |
494 |
|
|
$uploads_window->add_with_viewport( $ul_list ); |
495 |
|
|
|
496 |
|
|
my $stop_upload = new Gtk::Button("Kill Upload"); |
497 |
|
|
$uploads_box->pack_start($stop_upload, 0, 0, 0); |
498 |
|
|
$stop_upload->signal_connect("clicked", $session->postback('stop_upload_clicked')); |
499 |
|
|
|
500 |
|
|
$paned->set_position(300); |
501 |
|
|
|
502 |
|
|
|
503 |
|
|
### |
504 |
|
|
# End Widgets |
505 |
|
|
### |
506 |
|
|
|
507 |
|
|
$window->show_all; |
508 |
|
|
|
509 |
|
|
$kernel->yield('get_stats'); |
510 |
|
|
|
511 |
|
|
} |
512 |
|
|
|
513 |
|
|
sub download_clicked { # EVENT |
514 |
|
|
# download button clicked in GUI |
515 |
|
|
my ($kernel, $heap, $widget) = @_[KERNEL,HEAP,ARG0]; |
516 |
|
|
|
517 |
|
|
return if defined($heap->{waiting}); # only one ID at once |
518 |
|
|
|
519 |
|
|
my $list; |
520 |
|
|
if ( scalar(@{$heap->{queries}}) > 1 ) { |
521 |
|
|
my $page = $heap->{search_book}->get_current_page(); |
522 |
|
|
# get list from that page |
523 |
|
|
$list = $heap->{lists}->[$page]; |
524 |
|
|
} |
525 |
|
|
else { |
526 |
|
|
$list = $heap->{lists}->[0]; |
527 |
|
|
} |
528 |
|
|
|
529 |
|
|
my $row_selected = ($list->selection)[0]; |
530 |
|
|
my $hash = $list->get_text($row_selected,2); |
531 |
|
|
|
532 |
|
|
#&log("starting transfer for ",&href2filename($heap->{hashes}->{$hash}->[0]->{href})," $hash\n"); |
533 |
|
|
$kernel->yield('do_transfer',$hash); |
534 |
|
|
$heap->{waiting} = { event => 'transfer', hash => $hash }; |
535 |
|
|
} |
536 |
|
|
|
537 |
|
|
sub new_page { # SUBROUTINE |
538 |
|
|
# a new page in the search notebook is created for every search after the first one. |
539 |
|
|
my $heap = shift; |
540 |
|
|
my $query_number = scalar(@{$heap->{queries}}) - 1; |
541 |
|
|
|
542 |
|
|
my $query_scroll = new Gtk::ScrolledWindow( undef, undef ); |
543 |
|
|
my $tab_string = substr($heap->{queries}->[$query_number]->{query},0,10); |
544 |
|
|
$heap->{search_book}->append_page($query_scroll, Gtk::Label->new($tab_string)); #use query string |
545 |
|
|
|
546 |
|
|
my $gtklist = Gtk::CList->new_with_titles(qw(name size hash)); |
547 |
|
|
$gtklist->set_selection_mode('single'); |
548 |
|
|
$gtklist->set_column_width(0,200); |
549 |
|
|
$gtklist->set_column_width(1,100); |
550 |
|
|
$heap->{lists}->[$query_number] = $gtklist; |
551 |
|
|
$query_scroll->add_with_viewport( $gtklist ); |
552 |
|
|
$heap->{query_scrolls}->[$query_number] = $query_scroll; |
553 |
|
|
$query_scroll->show_all(); |
554 |
|
|
|
555 |
|
|
} |
556 |
|
|
|
557 |
|
|
|
558 |
|
|
sub query_clicked { # EVENT |
559 |
|
|
# the search button was clicked or enter hit in the keywords field in the GUI |
560 |
|
|
my ($kernel, $heap, $widget) = @_[KERNEL,HEAP,ARG0]; |
561 |
|
|
|
562 |
|
|
return if defined($heap->{waiting}); # only one ID at once |
563 |
|
|
|
564 |
|
|
my $query_number = scalar(@{$heap->{queries}}); # next available query slot |
565 |
|
|
|
566 |
|
|
if ( $query_number == 1) { |
567 |
|
|
# this is our second query, add notebook for more than one query |
568 |
|
|
|
569 |
|
|
# new notebook |
570 |
|
|
my $notebook = new Gtk::Notebook(); |
571 |
|
|
$heap->{search_book} = $notebook; |
572 |
|
|
$notebook->set_tab_pos('top'); |
573 |
|
|
|
574 |
|
|
# move the original scrolled window to this notebook page |
575 |
|
|
my $query_scroll_1 = $heap->{query_scrolls}->[0]; |
576 |
|
|
my $search_table = $heap->{search_table}; |
577 |
|
|
$search_table->remove($query_scroll_1); |
578 |
|
|
my $tab_string = substr($heap->{queries}->[0]->{query},0,10); |
579 |
|
|
$notebook->append_page($query_scroll_1, Gtk::Label->new($tab_string)); #use query string |
580 |
|
|
|
581 |
|
|
# add the notebook to the search table |
582 |
|
|
$search_table->attach($notebook,0,3,3,4,[qw(fill expand)], [qw(fill expand)], 0, 0 ); |
583 |
|
|
$search_table->show_all(); |
584 |
|
|
} |
585 |
|
|
|
586 |
|
|
|
587 |
|
|
my $realm = $heap->{realms}->{ $heap->{realm_menu}->get_active }; |
588 |
|
|
my $query = $heap->{entry}->get_text; |
589 |
|
|
$kernel->yield('do_query',$query,$realm); |
590 |
|
|
|
591 |
|
|
#need to add special cases for user and hash realms |
592 |
|
|
my %event = ( query => $query, finished => 0, hash => undef, id => undef, realm => $realm ); |
593 |
|
|
push @{$heap->{queries}},\%event; |
594 |
|
|
|
595 |
|
|
# set up to receive next ID |
596 |
|
|
$heap->{waiting} = { event => 'query', number => $query_number }; |
597 |
|
|
|
598 |
|
|
if ( $query_number ) { # for any additional queries |
599 |
|
|
&new_page($heap); |
600 |
|
|
$heap->{search_book}->set_page($query_number); |
601 |
|
|
} |
602 |
|
|
} |
603 |
|
|
|
604 |
|
|
|
605 |
|
|
sub id_in { # EVENT |
606 |
|
|
# we got an 'event' event which means we've been given and 'id' for some action. |
607 |
|
|
# give this id to the waiting search or transfer and start it up |
608 |
|
|
my ($heap,$event) = @_[HEAP,ARG0]; |
609 |
|
|
|
610 |
|
|
if ( defined($heap->{waiting}) ) { |
611 |
|
|
my $w_event = $heap->{waiting}->{event}; |
612 |
|
|
if ( $w_event eq 'query' ) { |
613 |
|
|
my $number = $heap->{waiting}->{number}; |
614 |
|
|
$heap->{queries}->[$number]->{id} = $$event{id}; |
615 |
|
|
$heap->{ids}->{$$event{id}} = $number; |
616 |
|
|
} |
617 |
|
|
elsif ( $w_event eq 'transfer' ) { |
618 |
|
|
# ready to add sources now |
619 |
|
|
my $id = $$event{id}; |
620 |
|
|
my $hash = $heap->{waiting}->{hash}; |
621 |
|
|
$heap->{transfers}->{$id}->{hash} = $hash; |
622 |
|
|
&add_sources($heap,$id,$hash); |
623 |
|
|
|
624 |
|
|
# add this download to the dl list in the GUI |
625 |
|
|
my $number = $heap->{dl_list}->rows(); |
626 |
|
|
$heap->{transfers}->{$id}->{dl_number} = $number; |
627 |
|
|
my $save = &href2filename($heap->{hashes}->{$hash}->[0]->{href}); |
628 |
|
|
$heap->{transfers}->{$id}->{save} = $save; |
629 |
|
|
my $size = $heap->{hashes}->{$hash}->[0]->{size}; |
630 |
|
|
$heap->{transfers}->{$id}->{size} = $size; |
631 |
|
|
$heap->{dl_list}->append($save, 0, $size, $hash); |
632 |
|
|
} |
633 |
|
|
elsif ( $w_event eq 'stats' ) { |
634 |
|
|
$heap->{stats}->{id} = $$event{id}; |
635 |
|
|
} |
636 |
|
|
else { |
637 |
|
|
&log("unknown event type waiting for id"); |
638 |
|
|
} |
639 |
|
|
$heap->{waiting} = undef; |
640 |
|
|
} |
641 |
|
|
else { |
642 |
|
|
&log("error: id but no event waiting"); |
643 |
|
|
} |
644 |
|
|
} |
645 |
|
|
|
646 |
|
|
|
647 |
|
|
sub add_sources { # SUBROUTINE |
648 |
|
|
# assumes we've already searched for more sources. |
649 |
|
|
my ($heap,$id,$hash) = @_; |
650 |
|
|
foreach my $source ( @{$heap->{hashes}->{$hash}} ) { # add sources one by one |
651 |
|
|
my $user = $$source{user}; |
652 |
|
|
next if exists($heap->{transfer}->{$id}->{users}->{$user}); |
653 |
|
|
my $href = $$source{href}; |
654 |
|
|
|
655 |
|
|
$heap->{io}->put(&event_to_data({event=>'transfer', id=>$id, user=>$user, hash=>$hash, addsource=>$href})); |
656 |
|
|
$heap->{transfer}->{$id}->{users}->{$user} = 1; |
657 |
|
|
} |
658 |
|
|
} |
659 |
|
|
|
660 |
|
|
sub end_id { # EVENT |
661 |
|
|
# we got something signaling the end of a search or transfer |
662 |
|
|
my ($heap,$event) = @_[HEAP,ARG0]; |
663 |
|
|
$heap->{queries}->[$heap->{ids}->{$$event{id}}]->{finished} = 1; |
664 |
|
|
} |
665 |
|
|
|
666 |
|
|
sub item_in { # EVENT |
667 |
|
|
# we received a search result. |
668 |
|
|
my ($heap,$event) = @_[HEAP,ARG0]; |
669 |
|
|
|
670 |
|
|
if ( not exists($heap->{ids}->{$$event{id}}) ) { |
671 |
|
|
&log('item with unknown id'); |
672 |
|
|
return; |
673 |
|
|
} |
674 |
|
|
|
675 |
|
|
if ( not exists($heap->{queries}->[$heap->{ids}->{$$event{id}}]->{hashes}->{$$event{hash}}) ) { |
676 |
|
|
# first time we've seen this hash, add to the GUI's list for this search id (notebook page). |
677 |
|
|
$heap->{queries}->[$heap->{ids}->{$$event{id}}]->{hashes}->{$$event{hash}} = 1; |
678 |
|
|
&print_item($heap,$event); |
679 |
|
|
} |
680 |
|
|
#not yet weeding out duplicates anywhere |
681 |
|
|
push @{$heap->{hashes}->{$$event{hash}}},$event; |
682 |
|
|
} |
683 |
|
|
|
684 |
|
|
sub print_item { # SUBROUTINE |
685 |
|
|
# not used for logging, rather prints the search result to the GUI (bad sub naming) |
686 |
|
|
my ($heap,$item) = @_; |
687 |
|
|
my $filename = &href2filename($$item{href}); |
688 |
|
|
#&log("file: $filename\tsize: $$item{size}"); |
689 |
|
|
my $query_number = $heap->{ids}->{$$item{id}}; |
690 |
|
|
$heap->{lists}->[$query_number]->append($filename,$$item{size},$$item{hash}); |
691 |
|
|
} |
692 |
|
|
|
693 |
|
|
sub href2filename { # SUBROUTINE |
694 |
|
|
# used for getting a quick filename to use in conjuction with transfers |
695 |
|
|
my $href = shift; |
696 |
|
|
$href =~ m{/([^/]+)$}; |
697 |
|
|
my $filename = $1; |
698 |
|
|
$filename =~ s{\%20}{ }g; |
699 |
|
|
return $filename; |
700 |
|
|
} |
701 |
|
|
|
702 |
|
|
sub dump { # SUBROUTINE |
703 |
|
|
# useful for logging |
704 |
|
|
my $string = Dumper(@_); |
705 |
|
|
#my @strings = split(/\n/,$string); |
706 |
|
|
&log($string); |
707 |
|
|
} |
708 |
|
|
|
709 |
|
|
sub log { # SUBROUTINE |
710 |
|
|
# logging |
711 |
|
|
print @_,"\n"; |
712 |
|
|
} |
713 |
|
|
|
714 |
|
|
|
715 |
|
|
|
716 |
|
|
package main; |
717 |
|
|
|
718 |
|
|
# all we do is create one instance of our monster object/session/package |
719 |
|
|
POE::Component::giFT->new(); |
720 |
|
|
|
721 |
|
|
|
722 |
|
|
$poe_kernel->run(); |
723 |
|
|
|