/[cvs]/joko/TestArea/perl/runtime/POE/giFT/gift.pl
ViewVC logotype

Annotation of /joko/TestArea/perl/runtime/POE/giFT/gift.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (hide annotations)
Sun May 11 21:48:51 2003 UTC (21 years, 6 months ago) by joko
Branch: MAIN
CVS Tags: HEAD
File MIME type: text/plain
initial commit

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    

MailToCvsAdmin">MailToCvsAdmin
ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed