| 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 |
|
Parent Directory
| 
Revision Log
