1package POE::Component::DebugShell; 2 3use warnings; 4use strict; 5 6use 5.006; 7 8use Carp; 9 10use POE; 11use POE::Wheel::ReadLine; 12use POE::API::Peek; 13 14our $VERSION = '1.412'; 15our $RUNNING = 0; 16our %COMMANDS; 17our $SPAWN_TIME; 18 19sub spawn { #{{{ 20 my $class = shift; 21 22 # Singleton check {{{ 23 if($RUNNING) { 24 carp "A ".__PACKAGE__." session is already running. Will not start a second."; 25 return undef; 26 } else { 27 $RUNNING = 1; 28 } 29 # }}} 30 31 my $api = POE::API::Peek->new() or croak "Unable to create POE::API::Peek object"; 32 33 34 # Session creation {{{ 35 my $sess = POE::Session->create( 36 inline_states => { 37 _start => \&_start, 38 _stop => \&_stop, 39 40 term_input => \&term_input, 41 }, 42 heap => { 43 api => $api, 44 }, 45 ); 46 # }}} 47 48 if($sess) { 49 $SPAWN_TIME = time(); 50 return $sess; 51 } else { 52 return undef; 53 } 54} #}}} 55 56 57 58sub _start { #{{{ 59 $_[KERNEL]->alias_set(__PACKAGE__." controller"); 60 61 $_[HEAP]->{rl} = POE::Wheel::ReadLine->new( InputEvent => 'term_input' ); 62 $_[HEAP]->{prompt} = 'debug> '; 63 64 tie *STDOUT, "POE::Component::DebugShell::Output", 'stdout', \&_output; 65 tie *STDERR, "POE::Component::DebugShell::Output", 'stderr', \&_output; 66 67 $_[HEAP]->{rl}->clear(); 68 _output("Welcome to POE Debug Shell v$VERSION"); 69 70 $_[HEAP]->{rl}->get($_[HEAP]->{prompt}); 71 72} #}}} 73 74 75 76sub _stop { #{{{ 77 # Shut things down 78 $_[HEAP]->{vt} && $_[HEAP]->{vt}->delete_window($_[HEAP]->{main_window}); 79} #}}} 80 81 82 83sub term_input { #{{{ 84 my ($input, $exception) = @_[ARG0, ARG1]; 85 86 unless (defined $input) { 87 croak("Received exception from UI: $exception"); 88 } 89 90 $_[HEAP]->{rl}->addhistory($input); 91 92 if($input =~ /^help (.*?)$/) { 93 my $cmd = $1; 94 if($COMMANDS{$cmd}) { 95 if($COMMANDS{$cmd}{help}) { 96 _output("Help for $cmd:"); 97 _output($COMMANDS{$cmd}{help}); 98 } else { 99 _output("Error: '$cmd' has no help."); 100 } 101 } else { 102 _output("Error: '$cmd' is not a known command"); 103 } 104 } elsif ( ($input eq 'help') or ($input eq '?') ) { 105 my $text; 106 _output(' '); 107 _output("General help for POE::Component::DebugShell v$VERSION"); 108 _output("The following commands are available:"); 109 foreach my $cmd (sort keys %COMMANDS) { 110 no warnings; 111 my $short_help = $COMMANDS{$cmd}{short_help} || '[ No short help provided ]'; 112 _output("\t* $cmd - $short_help"); 113 } 114 _output(' '); 115 116 } else { 117 my ($cmd, @args); 118 if($input =~ /^(.+?)\s+(.*)$/) { 119 $cmd = $1; 120 my $args = $2; 121 @args = split('\s+',$args) if $args; 122 } else { 123 $cmd = $input; 124 } 125 126 if($COMMANDS{$cmd}) { 127 my $txt = eval { $COMMANDS{$cmd}{cmd}->( api => $_[HEAP]->{api}, args => \@args); }; 128 if($@) { 129 _output("Error running $cmd: $@"); 130 } else { 131 my @lines = split(/\n/, $txt); 132 _output($_) for @lines; 133 } 134 } else { 135 _output("Error: '$cmd' is not a known command"); 136 } 137 } 138 139 $_[HEAP]->{rl}->get($_[HEAP]->{prompt}); 140 141} #}}} 142 143 144 145sub _output { #{{{ 146 my $msg = shift || ' '; 147 my $heap = $poe_kernel->alias_resolve(__PACKAGE__." controller")->get_heap(); 148 $heap->{rl}->put($msg); 149} #}}} 150 151sub _raw_commands { #{{{ 152 return \%COMMANDS; 153} #}}} 154 155# ____ _ 156# / ___|___ _ __ ___ _ __ ___ __ _ _ __ __| |___ 157# | | / _ \| '_ ` _ \| '_ ` _ \ / _` | '_ \ / _` / __| 158# | |__| (_) | | | | | | | | | | | (_| | | | | (_| \__ \ 159# \____\___/|_| |_| |_|_| |_| |_|\__,_|_| |_|\__,_|___/ 160# 161# {{{ 162 163%COMMANDS = ( #{{{ 164 165 'reload' => { 166 help => "Reload the shell to catch updates.", 167 short_help => "Reload the shell to catch updates.", 168 cmd => \&cmd_reload, 169 }, 170 171 show_sessions => { 172 help => 'Show a list of all sessions in the system. The output format is in the form of loggable session ids.', 173 short_help => 'Show a list of all sessions', 174 cmd => \&cmd_show_sessions, 175 }, 176 177 'list_aliases' => { 178 help => 'List aliases for a given session id. Provide one session id as a parameter.', 179 short_help => 'List aliases for a given session id.', 180 cmd => \&cmd_list_aliases, 181 }, 182 183 'session_stats' => { 184 help => 'Display various statistics for a given session id. Provide one session id as a parameter.', 185 short_help => 'Display various statistics for a given session id.', 186 cmd => \&cmd_session_stats, 187 }, 188 189 'queue_dump' => { 190 help => 'Dump the contents of the event queue.', 191 short_help => 'Dump the contents of the event queue.', 192 cmd => \&cmd_queue_dump, 193 }, 194 195 'status' => { 196 help => 'General shell status.', 197 short_help => 'General shell status.', 198 cmd => \&cmd_status, 199 }, 200); #}}} 201 202############### 203 204sub cmd_reload { #{{{ 205 my $ret; 206 $ret .= "Reloading....\n"; 207 eval q| 208 no warnings qw(redefine); 209 $SIG{__WARN__} = sub { }; 210 211 foreach my $key (keys %INC) { 212 if($key =~ m#POE/Component/DebugShell#) { 213 delete $INC{$key}; 214 } elsif ($key =~ m#POE/API/Peek#) { 215 delete $INC{$key}; 216 } 217 } 218 require POE::Component::DebugShell; 219 |; 220 $ret .= "Error: $@\n" if $@; 221 222 return $ret; 223} #}}} 224 225sub cmd_show_sessions { #{{{ 226 my %args = @_; 227 my $api = $args{api}; 228 229 my $ret; 230 $ret .= "Session List:\n"; 231 my @sessions = $api->session_list; 232 foreach my $sess (@sessions) { 233 my $id = $sess->ID. " [ ".$api->session_id_loggable($sess)." ]"; 234 $ret .= "\t* $id\n"; 235 } 236 237 return $ret; 238} #}}} 239 240sub cmd_list_aliases { #{{{ 241 my %args = @_; 242 my $user_args = $args{args}; 243 my $api = $args{api}; 244 245 my $ret; 246 247 if(my $id = shift @$user_args) { 248 if(my $sess = $api->resolve_session_to_ref($id)) { 249 my @aliases = $api->session_alias_list($sess); 250 if(@aliases) { 251 $ret .= "Alias list for session $id\n"; 252 foreach my $alias (sort @aliases) { 253 $ret .= "\t* $alias\n"; 254 } 255 } else { 256 $ret .= "No aliases found for session $id\n"; 257 } 258 } else { 259 $ret .= "** Error: ID $id does not resolve to a session. Sorry.\n"; 260 } 261 262 } else { 263 $ret .= "** Error: Please provide a session id\n"; 264 } 265 return $ret; 266} 267 268# }}} 269 270sub cmd_session_stats { #{{{ 271 my %args = @_; 272 my $user_args = $args{args}; 273 my $api = $args{api}; 274 275 my $ret; 276 277 if(my $id = shift @$user_args) { 278 if(my $sess = $api->resolve_session_to_ref($id)) { 279 my $to = $api->event_count_to($sess); 280 my $from = $api->event_count_from($sess); 281 $ret .= "Statistics for Session $id\n"; 282 $ret .= "\tEvents coming from: $from\n"; 283 $ret .= "\tEvents going to: $to\n"; 284 285 } else { 286 $ret .= "** Error: ID $id does not resolve to a session. Sorry.\n"; 287 } 288 289 290 } else { 291 $ret .= "** Error: Please provide a session id\n"; 292 } 293 294 return $ret; 295} #}}} 296 297sub cmd_queue_dump { #{{{ 298 my %args = @_; 299 my $api = $args{api}; 300 my $verbose; 301 302 my $ret; 303 304 if($args{args} && defined $args{args}) { 305 if(ref $args{args} eq 'ARRAY') { 306 if(@{$args{args}}[0] eq '-v') { 307 $verbose = 1; 308 } 309 } 310 } 311 312 my @queue = $api->event_queue_dump(); 313 314 $ret .= "Event Queue:\n"; 315 316 foreach my $item (@queue) { 317 $ret .= "\t* ID: ". $item->{ID}." - Index: ".$item->{index}."\n"; 318 $ret .= "\t\tPriority: ".$item->{priority}."\n"; 319 $ret .= "\t\tEvent: ".$item->{event}."\n"; 320 321 if($verbose) { 322 $ret .= "\t\tSource: ". 323 $api->session_id_loggable($item->{source}). 324 "\n"; 325 $ret .= "\t\tDestination: ". 326 $api->session_id_loggable($item->{destination}). 327 "\n"; 328 $ret .= "\t\tType: ".$item->{type}."\n"; 329 $ret .= "\n"; 330 } 331 } 332 return $ret; 333} #}}} 334 335sub cmd_status { #{{{ 336 my %args = @_; 337 my $api = $args{api}; 338 my $sess_count = $api->session_count; 339 my $ret = "\n"; 340 $ret .= "This is ".__PACKAGE__." v".$VERSION."\n"; 341 $ret .= "running inside $0."."\n"; 342 $ret .= "This console was spawned at ".localtime($SPAWN_TIME).".\n"; 343 $ret .= "There are $sess_count known sessions (including the kernel).\n"; 344 $ret .= "\n"; 345 return $ret; 346} # }}} 347 348# }}} 349 3501; 351 352package POE::Component::DebugShell::Output; 353 354use strict; 355#use warnings FATAL => "all"; 356 357sub PRINT { 358 my $self = shift; 359 360 my $txt = join('',@_); 361 $txt =~ s/\r?\n$//; 362 $self->{print}->($self->{type}."> $txt"); 363} 364 365sub TIEHANDLE { 366 my $class = shift; 367 bless({ 368 type => shift, 369 print => shift, 370 }, $class); 371} 372 3731; 374__END__ 375 376=pod 377 378=head1 NAME 379 380POE::Component::DebugShell - Component to allow interactive peeking into a 381running POE application 382 383=head1 SYNOPSIS 384 385 use POE::Component::DebugShell; 386 387 POE::Component::DebugShell->spawn(); 388 389=head1 DESCRIPTION 390 391This component allows for interactive peeking into a running POE 392application. 393 394C<spawn()> creates a ReadLine enabled shell equipped with various debug 395commands. The following commands are available. 396 397=head1 COMMANDS 398 399=head2 show_sessions 400 401 debug> show_sessions 402 * 3 [ session 3 (POE::Component::DebugShell controller) ] 403 * 2 [ session 2 (PIE, PIE2) ] 404 405Show a list of all sessions in the system. The output format is in the 406form of loggable session ids. 407 408=head2 session_stats 409 410 debug> session_stats 2 411 Statistics for Session 2 412 Events coming from: 1 413 Events going to: 1 414 415Display various statistics for a given session. Provide one session id 416as a parameter. 417 418=head2 list_aliases 419 420 debug> list_aliases 2 421 Alias list for session 2 422 * PIE 423 * PIE2 424 425List aliases for a given session id. Provide one session id as a 426parameter. 427 428=head2 queue_dump 429 430 debug> queue_dump 431 Event Queue: 432 * ID: 738 - Index: 0 433 Priority: 1078459009.06715 434 Event: _sigchld_poll 435 * ID: 704 - Index: 1 436 Priority: 1078459012.42691 437 Event: ping 438 439Dump the contents of the event queue. Add a C<-v> parameter to get 440verbose output. 441 442=head2 help 443 444 debug> help 445 The following commands are available: 446 ... 447 448Display help about available commands. 449 450=head2 status 451 452 debug> status 453 This is POE::Component::DebugShell v1.14 454 running inside examples/foo.perl. 455 This console spawned at Thu Mar 4 22:51:51 2004. 456 There are 3 known sessions (including the kernel). 457 458General shell status. 459 460=head2 reload 461 462 debug> reload 463 Reloading... 464 465Reload the shell 466 467=head2 exit 468 469 debug> exit 470 Exiting... 471 472Exit the shell 473 474=head1 DEVELOPERS 475 476For you wacky developers, I've provided access to the raw command data 477via the C<_raw_commands> method. The underbar at the beginning should 478let you know that this is an experimental interface for developers only. 479 480C<_raw_commands> returns a hash reference. The keys of this hash are the 481command names. The values are a hash of data about the command. This 482hash contains the following data: 483 484=over 4 485 486=item * short_help 487 488Short help text 489 490=item * help 491 492Long help text 493 494=item * cmd 495 496Code reference for the command. This command requires that a hash be 497passed to it containing an C<api> parameter, which is a 498C<POE::API::Peek> object, and an C<args> parameter, which is an array 499reference of arguments (think C<@ARGV>). 500 501=back 502 503=head1 AUTHOR 504 505Matt Cashner (sungo@pobox.com) 506 507=head1 LICENSE 508 509Copyright (c) 2003-2004, Matt Cashner 510 511Permission is hereby granted, free of charge, to any person obtaining 512a copy of this software and associated documentation files (the 513"Software"), to deal in the Software without restriction, including 514without limitation the rights to use, copy, modify, merge, publish, 515distribute, sublicense, and/or sell copies of the Software, and to 516permit persons to whom the Software is furnished to do so, subject 517to the following conditions: 518 519The above copyright notice and this permission notice shall be included 520in all copies or substantial portions of the Software. 521 522THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED 523WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 524MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO 525EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 526SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, 527PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; 528OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, 529WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR 530OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF 531ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 532 533=cut 534 535# sungo // vim: ts=4 sw=4 expandtab 536