1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53
#!/usr/bin/perl -w use strict; my $a = new A(); $a->pass_sub(); package A; use B; sub new { my ( $class, ) = @_; my $self = { }; bless $self, ref($class) || $class; return $self; } sub pass_sub { my ( $self, ) = @_; $self->{'sub_handler'} = new B(); $self->{'sub_handler'}->use_sub_later( sub { $self->say_hello } ); } sub say_hello { my ( $self, ) = @_; print "Hello! Args: ". join(',', @_) ."\n"; } 1; package B; sub new { my ( $class, ) = @_; my $self = { }; bless $self, ref($class) || $class; return $self; } sub use_sub_later { my ( $self, $sub, ) = @_; my $ready_to_use = 1; $sub->('ARG1', 'ARG2') if $ready_to_use; } 1;
$self->{'sub_handler'}->use_sub_later($self, \&say_hello );
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46
#!/usr/bin/perl use warnings; use strict; package A { sub new { my $classname = shift; my $self = {}; $self->{b} = B->new($self); return bless($self, $classname); } sub say_hello { my $self = shift; print "Hello! Args: ". join(',', @_) ."\n"; } sub pass_sub { my $self = shift; $self->{b}->use_sub_later(); } } package B { sub new { my $classname = shift; my $a = shift; my $self = {}; $self->{a} = $a; return bless($self, $classname); } sub use_sub_later { my $self = shift; my $ready_to_use = 1; if ($ready_to_use) { $self->{a}->say_hello('ARG1', 'ARG2'); } } } my $a = A->new(); $a->pass_sub();
2017-08-04T15:33:21 hlubenowWie würdest Du denn das Beispiel mit Aggregation machen?
$self->{'sub_handler'}->use_sub_later( sub { $self->say_hello } );
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48
package Helper; sub new{ my $class = shift; my %cfg = ( callback => undef, @_); # Callbackfunktion als Aggregat return bless{ callback => $cfg{callback} }, $class; } sub run{ my $self = shift; foreach my $label( qw(Anton Berta Cäsar Dora Emil) ){ # Callbackfunkton aufrufen # Keine Übergabe der Instanz # Übergeben werden nur die Daten $self->{callback}->($label); } } package main; # Funktionsreferenz my $callback = sub{ state $cnt = 0; print ++$cnt.": @_\n"; }; # eigene Instanz, Helper-Instanz als Aggregat my $main = bless{ HELPER => Helper->new(callback => $callback), }; # Delegation $main->{HELPER}->run; __END__ 1: Anton 2: Berta 3: Cäsar 4: Dora 5: Emil
2017-08-06T07:49:53 hlubenowHab's mir angesehen. Kapier' ich immer noch nicht richtig. Du definierst kein "$self" in "new()" von Helper?
Könntest Du bitte bei styx-ccs Beispiel mit "package A" und "package B" bleiben?
$self->{'sub_handler'}->use_sub_later( sub { $self->say_hello } );
$self->{'sub_handler'}->use_sub_later( sub { $self->say_hello(@_) } );
Hello! Args: A=HASH(0x459310),ARG1,ARG2
2017-08-04T17:04:39 LinuxerÜber den Sinn und Stil mögen sich andere auslassen ;-)
2017-08-04T17:04:39 Linuxer[...]
In Zeile 24:
Code (perl): (dl )$self->{'sub_handler'}->use_sub_later( sub { $self->say_hello } );
Wie kommen denn die Argumente, die der anonymen Subroutine später übergeben werden sollen, in den Methodenaufruf $self->say_hello?
[...]
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162
#!/usr/bin/perl use strict; use warnings; use Tk; use HTTP::Request; my $handler = RequestHandler->new(); my $time; init_time(); my $mw = tkinit(); $mw->Label(-text => 'Time: ')->pack(-side => 'left'); $mw->Label(-textvariable => \$time )->pack(-side => 'left'); $mw->repeat(100 => sub { $handler->listener(); $mw->update(); }); MainLoop; sub init_time { $handler->add_listener('_time', sub { _time(@_) } ); _time(); } sub _time { my ($value) = @_; $handler->add_request( HTTP::Request->new('GET', 'http://bit.ly/2v7njgk'), '_time', sub { _time(@_) } ); $time = $value if $value; } package RequestHandler; use strict; use warnings; use HTTP::Async; sub new { my ( $class, ) = @_; my $self = { parallel_requests => 20, #async default requests_per_task => 5, # useful in times of lagging, asking several times and take the first error-free response request_delay => 0.1, #in s, including decimals }; bless $self, ref($class) || $class; return $self; } sub _async { my ($self, ) = @_; $self->{'HTTP'}->{'async'} = HTTP::Async->new() unless $self->{'HTTP'}->{'async'}; return $self->{'HTTP'}->{'async'}; } sub listener { my ( $self, ) = @_; $self->_handle_responses(); for my $listener ( keys %{ $self->{'listen_to'} } ) { my $callback = $self->{'listen_to'}->{$listener}->{'sub'}; my $args = $self->{'listen_to'}->{$listener}->{'arg'}; #print "LISTEN\n"; $callback->($args || ''); } } sub add_listener { my ( $self, $name, $sub, $arg, ) = @_; print "New Listener: $name\n"; $self->{'listen_to'}->{$name}->{'sub'} = $sub; $self->{'listen_to'}->{$name}->{'arg'} = $arg; #dyn args dev } sub add_request { my ($self, $req, $req_type, $callback) = @_; if (defined $self->{'request_map'}->{$req_type}) { if ( ( @{ $self->{'request_map'}->{$req_type}->{'ids'} } >= $self->{'requests_per_task'} ) || ( ( time - $self->{'request_map'}->{$req_type}->{'time'} ) <= $self->{'request_delay'} ) ) { return undef; } } my $id = $self->_async->add($req); push @{ $self->{'request_map'}->{$req_type}->{'ids'} }, $id; $self->{'request_map'}->{$req_type}->{'time'} = time(); $self->{'request_map'}->{$req_type}->{'callback'} = $callback; print "ID: $id - $req_type\n"; return $id } sub _handle_requests { my ( $self, $id, $content, $http_error ) = @_; for my $req_type ( keys %{ $self->{'request_map'} } ) { my $queued_ids = \$self->{'request_map'}->{$req_type}->{'ids'}; for my $queued_id (@{ $$queued_ids }) { if ( $id eq $queued_id ) { #only remove queue if we haven't an http-error in response unless ( $http_error ) { for my $del_id (@{ $$queued_ids }) { $self->_async->remove($del_id); } $$queued_ids = []; } else { @{ $$queued_ids } = grep {$_ ne $id} @{ $$queued_ids }; } my $callback = $self->{'request_map'}->{$req_type}->{'callback'}; $callback->($content); return 1; } } } return 0; } sub _handle_responses { my ( $self, ) = @_; while ( my ($res, $id) = $self->_async->next_response ) { print "Working on $id\n"; my ( $content, $http_error ) = ( undef, 0 ); if ( $res->is_success ) { $content = $res->content; } else { $content = $res->status_line; $http_error = 1; } $self->_handle_requests($id, $content, $http_error); } } sub DESTROY { my ( $self, ) = @_; $self->_async->remove_all(); } 1;
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21
my $handler = RequestHandler->new(); my $mw = tkinit(); $mw->Label(-text => 'Time: ')->pack(-side => 'left'); # Callbackfunktion *time = sub { $handler->add_request( HTTP::Request->new('GET', 'http://bit.ly/2v7njgk'), '_time', sub { my $label = shift or return; $mw->Label(-textvariable => \$label )->pack(-side => 'left'); } ); }; $handler->add_listener('_time', *time ); $mw->repeat(100 => sub { $handler->listener(); $mw->update(); }); MainLoop;