root/lang/perl/POE-Component-RemoteTail/branches/refactor2/lib/POE/Component/RemoteTail.pm @ 30657

Revision 30657, 7.3 kB (checked in by miki, 4 years ago)

リファクタ用のブランチ

Line 
1package POE::Component::RemoteTail;
2
3use strict;
4use warnings;
5use POE;
6use POE::Wheel::Run;
7use POE::Component::RemoteTail::Job;
8use IO::Pty;
9use Class::Inspector;
10use constant DEBUG => 0;
11use UNIVERSAL::require;
12
13our $VERSION = '0.02001';
14
15*debug = DEBUG
16  ? sub {
17    my $mess = shift;
18    print STDERR $mess, "\n";
19  }
20  : sub { };
21
22sub spawn {
23    my $class = shift;
24    my $self  = $class->new(@_);
25
26    $self->{alias} ||= "tailer";
27    $self->{session_id} =
28      POE::Session->create(
29        object_states => [ $self => Class::Inspector->methods($class) ], )
30      ->ID();
31
32    return $self;
33}
34
35sub new {
36    my $class = shift;
37
38    return bless {@_}, $class;
39}
40
41sub session_id {
42    return shift->{session_id};
43}
44
45sub job {
46    my $self = shift;
47
48    my $job = POE::Component::RemoteTail::Job->new(@_);
49    return $job;
50}
51
52sub start_tail {
53    my ( $self, $kernel, $session, $heap, $arg ) =
54      @_[ OBJECT, KERNEL, SESSION, HEAP, ARG0 ];
55
56    $arg->{postback} and $heap->{postback} = $arg->{postback};
57    $kernel->post( $session, "_spawn_child" => $arg->{job} );
58}
59
60sub stop_tail {
61    my ( $self, $kernel, $session, $heap, $arg ) =
62      @_[ OBJECT, KERNEL, SESSION, HEAP, ARG0 ];
63
64    my $job = $arg->{job};
65    debug("STOP:$job->{id}");
66    my $wheel = $heap->{wheel}->{ $job->{id} };
67    $wheel->kill(9);
68    delete $heap->{wheel}->{ $job->{id} };
69    delete $heap->{host}->{ $job->{id} };
70    undef $job;
71}
72
73sub _start {
74    my ( $self, $kernel ) = @_[ OBJECT, KERNEL ];
75
76    $kernel->alias_set( $self->{alias} );
77    $kernel->sig( INT => "_stop" );
78}
79
80sub _stop {
81    my ( $self, $kernel, $heap ) = @_[ OBJECT, KERNEL, HEAP ];
82
83    my ( $whee_id, $wheel ) = each %{ $heap->{wheel} };
84    $wheel and $wheel->kill(9);
85}
86
87sub _spawn_child {
88    my ( $self, $kernel, $session, $heap, $job, $sender ) =
89      @_[ OBJECT, KERNEL, SESSION, HEAP, ARG0, SENDER ];
90
91    # prepare ...
92    my $class = $job->{process_class};
93    my $host  = $job->{host};
94    my $path  = $job->{path};
95    my $user  = $job->{user};
96    my $ssh_options = $job->{ssh_options};
97    my $add_command = $job->{add_command};
98
99    my $command = "ssh -A";
100    $command .= ' ' . $ssh_options if $ssh_options;
101    $command .= " $user\@$host tail -f $path";
102    $command .= ' ' . $add_command if $add_command;
103
104    # default Program ( go on a simple unix command )
105    my %program = ( Program => $command );
106
107    # use custom class
108    if ( my $class = $job->{process_class} ) {
109        $class->require or die(@!);
110        $class->new();
111        %program = ( Program => sub { $class->process_entry($job) }, );
112    }
113
114    $SIG{CHLD} = "IGNORE";
115
116    # run wheel
117    my $wheel = POE::Wheel::Run->new(
118        %program,
119        Conduit => 'pty-pipe',
120        StdioFilter => POE::Filter::Line->new(),
121        StdoutEvent => "_got_child_stdout",
122        StderrEvent => "_got_child_stderr",
123        CloseEvent  => "_got_child_close",
124    );
125
126    my $id = $wheel->ID;
127    $heap->{wheel}->{$id} = $wheel;
128    $heap->{host}->{$id}  = $host;
129    $job->{id}            = $id;
130}
131
132sub _got_child_stdout {
133    my ( $kernel, $session, $heap, $stdout, $wheel_id ) =
134      @_[ KERNEL, SESSION, HEAP, ARG0, ARG1 ];
135    debug("STDOUT:$stdout");
136
137    my $host = $heap->{host}->{$wheel_id};
138
139    if ( $heap->{postback} ) {
140        $heap->{postback}->( $stdout, $host );
141    }
142    else {
143        print $stdout, $host;
144    }
145}
146
147sub _got_child_stderr {
148    my $stderr = $_[ARG0];
149    debug("STDERR:$stderr");
150    die("got_child_stderr: $stderr");
151}
152
153sub _got_child_close {
154    my ( $heap, $wheel_id ) = @_[ HEAP, ARG0 ];
155    delete $heap->{wheel}->{$wheel_id};
156    debug("CLOSE:$wheel_id");
157}
158
1591;
160
161__END__
162
163=head1 NAME
164
165POE::Component::RemoteTail - tail to remote server's access_log on ssh connection.
166
167=head1 SYNOPSIS
168
169  use POE;
170  use POE::Component::RemoteTail;
171 
172  my ( $host, $path, $user ) = @target_host_info;
173  my $alias = 'Remote_Tail';
174 
175  # spawn component
176  my $tailer = POE::Component::RemoteTail->spawn( alias => $alias );
177 
178  # create job
179  my $job = $tailer->job(
180      host          => $host,
181      path          => $path,
182      user          => $user,
183      ssh_options   => $ssh_options, # see POE::Component::RemoteTail::Job
184      add_command   => $add_command, # see POE::Component::RemoteTail::Job
185  );
186 
187  # prepare the postback subroutine at main POE session
188  POE::Session->create(
189      inline_states => {
190          _start => sub {
191              my ( $kernel, $session ) = @_[ KERNEL, SESSION ];
192              # create postback
193              my $postback = $session->postback("MyPostback");
194 
195              # post to execute
196              $kernel->post( $alias,
197                  "start_tail" => { job => $job, postback => $postback } );
198          },
199 
200          # return to here
201          MyPostback => sub {
202              my ( $kernel, $session, $data ) = @_[ KERNEL, SESSION, ARG1 ];
203              my $log  = $data->[0];
204              my $host = $data->[1];
205              ... do something ...;
206          },
207      },
208  );
209 
210  POE::Kernel->run();
211
212
213=head1 DESCRIPTION
214
215POE::Component::RemoteTail provides some loop events that tailing access_log on remote host.
216It replaces "ssh -A user@host tail -f access_log" by the same function.
217
218This moduel does not allow 'PasswordAuthentication'.
219Use RSA or DSA keys, or you must write your Custom Engine with this module.
220( ex. POE::Component::RemoteTail::CustomEngine::NetSSHPerl.pm )
221
222
223=head1 EXAMPLE
224
225If you don't prepare 'postback', PoCo::RemoteTail outputs log data to child process's STDOUT.
226
227  use POE::Component::RemoteTail;
228 
229  my $tailer = POE::Component::RemoteTail();
230  my $job = $tailer->job( host => $host, path => $path, user => $user );
231  POE::Session->create(
232      inlines_states => {
233          _start => sub {
234              $kernel->post($tailer->session_id, "start_tail" => {job => $job});
235          },
236      }
237  );
238  POE::Kernel->run();
239
240
241It can tail several servers at the same time.
242
243  use POE::Component::RemoteTail;
244 
245  my $tailer = POE::Component::RemoteTail(alias => $alias);
246
247  my $job_1 = $tailer->job( host => $host1, path => $path, user => $user );
248  my $job_2 = $tailer->job( host => $host2, path => $path, user => $user );
249
250  POE::Session->create(
251      inlines_states => {
252          _start => sub {
253              my $postback = $session->postback("MyPostback");
254              $kernel->post($alias, "start_tail" => {job => $job_1, postback => $postback});
255              $kernel->post($alias, "start_tail" => {job => $job_2, postback => $postback});
256              $kernel->delay_add("stop_tail", 10, [ $job_1 ]);
257              $kernel->delay_add("stop_tail", 20, [ $job_1 ]);
258          },
259          MyPostback => sub {
260              my ( $kernel, $session, $data ) = @_[ KERNEL, SESSION, ARG1 ];
261              my $log  = $data->[0];
262              my $host = $data->[1];
263              ... do something ...;
264          },
265          stop_tail => sub {
266              my ( $kernel, $session, $arg ) = @_[ KERNEL, SESSION, ARG0 ];
267              my $target_job = $arg->[0];
268              $kernel->post( $alias, "stop_tail" => {job => $target_job});
269          },
270      },
271  );
272  POE::Kernel->run();
273
274
275=head1 METHOD
276
277=head2 spawn()
278
279=head2 job()
280
281=head2 start_tail()
282
283=head2 stop_tail()
284
285=head2 session_id()
286
287=head2 debug()
288
289=head2 new()
290
291=head1 AUTHOR
292
293Takeshi Miki E<lt>miki@cpan.orgE<gt>
294
295=head1 LICENSE
296
297This library is free software; you can redistribute it and/or modify
298it under the same terms as Perl itself.
299
300=head1 SEE ALSO
301
302=cut
Note: See TracBrowser for help on using the browser.