POE-1.370/000755 001751 001751 00000000000 14216613074 012761 5ustar00bingosbingos000000 000000 POE-1.370/t/000755 001751 001751 00000000000 14216613074 013224 5ustar00bingosbingos000000 000000 POE-1.370/lib/000755 001751 001751 00000000000 14216613074 013527 5ustar00bingosbingos000000 000000 POE-1.370/mylib/000755 001751 001751 00000000000 14216613074 014075 5ustar00bingosbingos000000 000000 POE-1.370/HISTORY000644 001751 001751 00000037051 12143730317 014050 0ustar00bingosbingos000000 000000 $Id$ A brief, pointless history of POE's evolution. ------------------------------------------------------------------------------- Received: from sinistar.idle.com (sinistar.idle.com [198.109.160.36]) by anshar.shadow.net (8.7.3/8.7.3) with ESMTP id JAA05315 for ; Fri, 7 Feb 1997 09:59:05 -0500 (EST) Received: (from slist@localhost) by sinistar.idle.com (8.7.5/8.7.3) id JAA12501; Fri, 7 Feb 1997 09:00:15 -0500 (EST) Resent-Date: Fri, 7 Feb 1997 09:00:15 -0500 (EST) Message-Id: <199702071400.JAA00295@anshar.shadow.net> From: "Rocco Caputo" To: "Felix Gallo" , "perl5-porters@perl.org" Date: Fri, 07 Feb 97 08:54:23 -0400 Reply-To: "Rocco Caputo" Priority: Normal Subject: portable multithreading Resent-Message-ID: <"O2kshC.A.W5C.lTz-y"@sinistar> Resent-From: perl5-porters@perl.org X-Mailing-List: archive/latest/135 X-Loop: perl5-porters@perl.org Precedence: list Resent-Sender: perl5-porters-request@perl.org Content-Type: text Content-Length: 3989 Status: On Thu, 06 Feb 1997 12:52:56 +0000, Felix Gallo wrote: >Felix's Perl-related Metaproblems: > >1. Perl is not event-driven, so programs which wish >to make objects available to the network must manually >interrupt their control flow to determine if a remote >object transaction request is pending. I'm writing a MUD in perl. The object language faces some of the same issues as perl, but I think there are ways around them (in the MUD language and in perl). In the MUD server, objects' methods must be compiled into perl bytecode. They must be multitasked/multithreaded so that bad code won't hang the server, and object authors usually should not have to think about events. For example, this "bad" MUD code will be legal. Don't worry, I move on to perl in just a minute. count = 10000000 while count-- say "hello, world! enter some text: " getline some_text if some_text eq 'quit' last endif endwhile say "\ngoodbye, world!\n" This needs to be compiled to perl bytecode at runtime. The MUD bytecode compiler first parses and syntax checks an object's source. If everything passes, it builds a perl sub definition in a string. This sub-in-a-string is treated as an assembly language for perl bytecode. The server runs eval() to assemble the string-o-perl into bytecodes, and then the resulting sub can be called over and over without additional eval() overhead. (Thanks, Silmaril!) Making that bad loop work in an event-driven server is a little harder than making bytecodes. The MUD compiler will build perl assembly as event-driven state machines. It can do this by noting the locations of branch destinations and returns from blocking calls. Each of these locations starts a new atomic "state", and an "instruction pointer" determines which state to run next. Here's the event-driven perl "assembly" for that sample MUD code. It's not very efficient, but it serves for illustration. sub aaaaa { # assumes the existence of a tasking/event kernel my $task = shift; my $namespace = $task->{"namespace"}; my $ip = $task->{'instruction pointer'}; # state # initial entry point if ($ip == 0) { $namespace->{'count'} = 10000000 ; $task->{'instruction pointer'} = 1; } # top of while loop elsif ($ip == 1) { if ( $namespace->{'count'} -- ) { $task->say( qq(hello, world! enter some text: ) ) ; # soft block on 'getline' $task->{'blocking'} = 'getline'; $task->{'instruction pointer'} = 2; } else { $task->{'instruction pointer'} = 3; } } # "return" from getline elsif ($ip == 2) { $namespace->{'some_text'} = $task->getline(); if ( $namespace->{'some_text'} eq q(quit) ) { $task->{'instruction pointer'} = 3; } else { $task->{'instruction pointer'} = 1; } } # after endwhile elsif ($ip == 3) { $task->say( qq(\ngoodbye, world!\n) ) ; $task->{'instruction pointer'} = -1; # signals end } } The main select/event loop would have some code to run tasks round-robin. Something like this, but probably including code to deal with priorities. if ($next = shift(@task_queue)) { if (($next->{'blocking'}) || ($next->run() != -1)) { push(@task_queue, $next); } else { undef $next; } } And starting a new task might look like this: $task = new Task($tasking_kernel, "count = ... world!\n"); if ($task->has_errors()) { $task->display_errors(); undef $task; } # otherwise the task has been compiled and registered # with the $tasking_kernel Anyway, that's how I'm writing portable multitasking for a syntactically simple MUD language. To make this work for perl, there would be a standard tasking package, and perl's bytecode compiler would need to modify its output to work with the package. Sort of like how the perl debugger works. Just some ideas to ponder. Rocco ------------------------------------------------------------------------------- Received: from sinistar.idle.com ([198.109.160.36]) by anshar.shadow.net (8.8.5/8.7.3) with ESMTP id VAA13861 for ; Mon, 14 Apr 1997 21:04:07 -0400 (EDT) Received: (from slist@localhost) by sinistar.idle.com (8.7.5/8.7.3) id UAA24149; Mon, 14 Apr 1997 20:37:16 -0400 (EDT) Resent-Date: Mon, 14 Apr 1997 20:37:16 -0400 (EDT) Message-Id: <199704150040.UAA11517@anshar.shadow.net> From: "Rocco Caputo" To: "Gary Howland" , "Tom Christiansen" Cc: "Gary Howland" , "Hugo van der Sanden" , "hv@tyree.iii.co.uk" , "perl5-porters@perl.org" Date: Mon, 14 Apr 97 20:34:01 -0500 Reply-To: "Rocco Caputo" Priority: Normal MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Subject: Re: Perl5.005 wish list (event loop) Resent-Message-ID: <"99mWD.A.PzF.i0sUz"@sinistar> Resent-From: perl5-porters@idle.com X-Mailing-List: archive/latest/6171 X-Loop: perl5-porters@idle.com Precedence: list Resent-Sender: perl5-porters-request@idle.com Content-Type: text/plain; charset="iso-8859-1" Content-Length: 1119 Status: Gary, et al, Almost a year ago, I quietly announced something called "Serv + Face". Maybe my announcement was a little too quiet. Serv is a fork-less, select-based framework of event server classes. It provides a high level interface to select(), and a very high level interface to TCP client and server socket operations. It does not fork. Face is the start of a curses-based UI framework that can run alone or use Serv as its main loop. The code and a rough draft of the documentation are available from . If this code is useful to anyone, I'd sure like to know. Rocco On Tue, 15 Apr 1997 01:36:35 +0200, Gary Howland wrote: > >Select is fine. What we (the "event evangelists") want is a "level above" >select. When we have a chunk of data to send to x streams, we don't want to >have to call select, see which stream is ready for writing, work out how >many bytes we can send, send those bytes, shorten our buffers by that amount >of bytes, and loop back to select. We just want to send the data. And we >want to do this without forking. ------------------------------------------------------------------------------- Received: from sinistar.idle.com (sinistar.idle.com [198.109.160.36]) by anshar.shadow.net (8.7.3/8.7.3) with ESMTP id JAA04948 for ; Fri, 7 Feb 1997 09:54:31 -0500 (EST) Received: (from slist@localhost) by sinistar.idle.com (8.7.5/8.7.3) id JAA12519; Fri, 7 Feb 1997 09:00:19 -0500 (EST) Resent-Date: Fri, 7 Feb 1997 09:00:19 -0500 (EST) Message-Id: <199702071400.JAA00339@anshar.shadow.net> From: "Rocco Caputo" To: "Felix Gallo" , "perl5-porters@perl.org" Date: Fri, 07 Feb 97 08:54:31 -0400 Reply-To: "Rocco Caputo" Priority: Normal Subject: polytheistic perl references Resent-Message-ID: <"1y3hHB.A.w5C.sTz-y"@sinistar> Resent-From: perl5-porters@perl.org X-Mailing-List: archive/latest/136 X-Loop: perl5-porters@perl.org Precedence: list Resent-Sender: perl5-porters-request@perl.org Content-Type: text Content-Length: 1502 Status: On Thu, 06 Feb 1997 12:52:56 +0000, Felix Gallo wrote: >Felix's Perl-related Metaproblems: > >3. Perl references are monotheistic. One fancies that saying >$x = \{ http://perl.com/myperlobject }; would do the right thing, >but the established structure of Perl seems to make this difficult. There are tied hash packages that implement object naming and message passing between named objects within the same process. The packages allow invocations like: $msg{'desktop,paint'} = 1; $msg{'name entry,value'} = 'J. K. Cohen'; $active_flag = $msg{'active checkbox,value'}; The packages also do broadcasting to subsets of the object dictionary. Hash stores and fetches are sent to or taken from all the objects that match the supplied name. So to clear the value of all objects that have 'entry' in their names: $msg{'entry,value'} = ''; That clears 'name entry' and 'age entry' and 'salary entry' and .... Anyway, the names could be extended to work across sockets in the presence of a standard select/event loop: $gnats_queue = $msg{'//somewhere.com:4242/stickynote/gnat?count'}; print "gnat has $gnats_queue unread sticky notes.\n"; $message = 'hello, world!'; $msg{'//somewhere.org:4242/stickynote/merlyn?queue'} = $message; Man pages for ObjDict::Names and ObjDict::Messages are on-line at . The code is inside a larger package, Serv+Face, at . Just some ideas to ponder. Rocco ------------------------------------------------------------------------------- This is a header from a program I was writing before I discovered Perl. // ========================================================================= // UBERSYS.H // UberSys definitions and classes. // ========================================================================= #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include // ------------------------------------------------------------------------- // Constants, limits, and the like. #define SIZE_UID 9 // including NULL terminator #define SIZE_PWD 26 // including NULL terminator #define SIZE_MAXSTR 0x1000 // 4k string sizes (max) #define SIZE_MAXPATH 0x0050 // 160 chars for max path #define SIZE_MAXLINE 0x00A0 // 160 characters per line #define COUNT_LINES 0x0200 // 512 editor lines #define USREV 0x0200 // version 02.00 #define DRV "D:" // drive it runs on // ------------------------------------------------------------------------- // Helper macros. // build a 20-bit address from segoff #define A20(x) (((ULI)FP_SEG(x)<<4)+(ULI)FP_OFF(x)) // make a normalized pointer from A20 #define A32(x) MK_FP((UINT)((x)>>4), (UINT)((x)&0x0F)) // normalize a far pointer using A20 #define NORM(x) A32(A20(x)) // maximum of two values template T max(T x, T y) { return((x>y)?x:y); }; // minimum of two values template T min(T x, T y) { return((x install POE Or % cpan -i POE http://poe.perl.org/?Where_to_Get_POE explains other options for obtaining POE, including anonymous Subversion access. ------------ Test Results ------------ The CPAN Testers are a group of volunteers who test new CPAN distributions on a number of platforms. You can see their test results at: http://testers.cpan.org/search?request=dist&dist=POE POE's ongoing improvement relies on your feedback. You file bug reports, feature requests, and even success stories by e-mailing . ------------- Test Coverage ------------- POE's tests cover a significant portion of the distribution. A thumbnail sketch of POE's test coverage is available, but do not use it as an accurate gauge of quality. http://poe.perl.org/?POE's_test_coverage_report ---------------- Full Change Logs ---------------- Thanks to the magic of distributed version control, POE is hosted at three locations for redundancy. You can browse the source at any one of: https://github.com/rcaputo/poe https://gitorious.org/poe http://poe.git.sourceforge.net/git/gitweb-index.cgi Complete change logs can also be browsed at those sites. They all provide RSS news feeds for those who want to follow development in near-realtime. ----------- What POE Is ----------- POE is an event-driven networking and multitasking framework for Perl. It has been in active development since 1996, with its first open release in 1998. O'Reilly's "The Perl Conference" (now OSCON's Perl track) named POE "Best New Module" in 1999. POE has been used in mission-critical systems such as internetworked financial markets, file systems, commerce and application servers. It has been used in projects ranging from a few lines of code to tens of thousands. POE is compatible with perl versions as old as 5.005_03. This may change as it becomes harder to support old versions of Perl over time. POE includes an evolving component framework. Components are high-level, modular, reusable pieces of programs. Several components have been published on the CPAN, and more are listed on POE's web site. See: http://search.cpan.org/search?query=POE&mode=dist POE includes components and libraries for making quick work of network clients, servers, and peers. A simple stand-alone web application takes about 30 lines of code, most of which is your own custom logic. ---- Bye! ---- Thanks for reading! -- Rocco Caputo / rcaputo@cpan.org / http://poe.perl.org/ POE-1.370/TODO000644 001751 001751 00000001124 12143730315 013442 0ustar00bingosbingos000000 000000 $Id$ ------------------ Where Did This Go? ------------------ The contents of this file have moved to the 'web. You can find them at . POE's web site is live editable by nearly everyone. Readers can quickly patch errors or omissions on the site rather than wait for their comments to percolate through e-mail and a maintainer's schedule. Please see for information on acquiring an account on the site and setting your editing and viewing preferences. --------------------------- EOF: Thank you for reading. --------------------------- POE-1.370/CHANGES000644 001751 001751 00000001442 14216613077 013760 0ustar00bingosbingos000000 000000 ================================ 2022-03-23 12:42:01 +0000 v1_370 ================================ commit 8d07be6dbc4b89c79f66c52b736895010f5f65dd Author: Chris 'BinGOs' Williams Date: Wed Mar 23 12:42:01 2022 +0000 Version bump for release. commit f8587e83eae3bd5d9a1243841b50118d0b185dd7 Author: Chris 'BinGOs' Williams Date: Tue Mar 22 14:46:48 2022 +0000 Remove explicit call to setsid() in POE::Wheel::Run We are using make_slave_controlling_terminal() from IO::Pty since 136f5dbab9d9 and that calls setsid() itself. Fixes to IO::Pty have unmasked this double call to setsid() which is generating a spurious warning on any use of a pty(-pipe) conduit. ============== End of Excerpt ============== POE-1.370/MANIFEST.SKIP000644 001751 001751 00000000507 12143730314 014653 0ustar00bingosbingos000000 000000 CVS \.\# \.bak$ \.cvsignore \.gz$ \.orig$ \.patch$ \.ppd$ \.rej$ \.rej$ \.svn \.swo$ \.swp$ ^Makefile$ ^Makefile\.old$ ^POE.ppd$ ^\. ^_Inline ^_build ^blib/ ^comptest ^cover_db ^coverage\.report$ ^docs ^pm_to_blib$ ^poe_report\.xml$ run_network_tests test-output\.err$ t/[23]0_.*\.t ~$ # Work in Progress ^lib/POE/Loader\.pm$ POE-1.370/MANIFEST000644 001751 001751 00000012225 14216613074 014114 0ustar00bingosbingos000000 000000 CHANGES HISTORY MANIFEST This list of files MANIFEST.SKIP Makefile.PL README TODO examples/README.samples examples/create.perl examples/fakelogin.perl examples/forkbomb.perl examples/names.perl examples/objmaps.perl examples/objsessions.perl examples/packagesessions.perl examples/queue.perl examples/selects.perl examples/sessions.perl examples/signals.perl examples/tcp_watermarks.perl examples/thrash.perl examples/watermarks.perl examples/wheels2.perl lib/POE.pm lib/POE/Component.pm lib/POE/Component/Client/TCP.pm lib/POE/Component/Server/TCP.pm lib/POE/Driver.pm lib/POE/Driver/SysRW.pm lib/POE/Filter.pm lib/POE/Filter/Block.pm lib/POE/Filter/Grep.pm lib/POE/Filter/HTTPD.pm lib/POE/Filter/Line.pm lib/POE/Filter/Map.pm lib/POE/Filter/RecordBlock.pm lib/POE/Filter/Reference.pm lib/POE/Filter/Stackable.pm lib/POE/Filter/Stream.pm lib/POE/Kernel.pm lib/POE/Loop.pm lib/POE/Loop/IO_Poll.pm lib/POE/Loop/PerlSignals.pm lib/POE/Loop/Select.pm lib/POE/NFA.pm lib/POE/Pipe.pm lib/POE/Pipe/OneWay.pm lib/POE/Pipe/TwoWay.pm lib/POE/Queue.pm lib/POE/Queue/Array.pm lib/POE/Resource.pm lib/POE/Resource/Aliases.pm lib/POE/Resource/Clock.pm lib/POE/Resource/Events.pm lib/POE/Resource/Extrefs.pm lib/POE/Resource/FileHandles.pm lib/POE/Resource/SIDs.pm lib/POE/Resource/Sessions.pm lib/POE/Resource/Signals.pm lib/POE/Resources.pm lib/POE/Session.pm lib/POE/Test/Sequence.pm lib/POE/Wheel.pm lib/POE/Wheel/Curses.pm lib/POE/Wheel/FollowTail.pm lib/POE/Wheel/ListenAccept.pm lib/POE/Wheel/ReadLine.pm lib/POE/Wheel/ReadWrite.pm lib/POE/Wheel/Run.pm lib/POE/Wheel/SocketFactory.pm mylib/Devel/Null.pm mylib/ForkingDaemon.pm mylib/MyOtherFreezer.pm mylib/PoeBuildInfo.pm mylib/coverage.perl mylib/cpan-test.perl mylib/events_per_second.pl mylib/gen-tests.perl mylib/svn-log.perl t/00_info.t t/10_units/01_pod/01_pod.t t/10_units/01_pod/02_pod_coverage.t t/10_units/01_pod/03_pod_no404s.t t/10_units/01_pod/04_pod_linkcheck.t t/10_units/02_pipes/01_base.t t/10_units/02_pipes/02_oneway.t t/10_units/02_pipes/03_twoway.t t/10_units/03_base/01_poe.t t/10_units/03_base/03_component.t t/10_units/03_base/04_driver.t t/10_units/03_base/05_filter.t t/10_units/03_base/06_loop.t t/10_units/03_base/07_queue.t t/10_units/03_base/08_resource.t t/10_units/03_base/09_resources.t t/10_units/03_base/10_wheel.t t/10_units/03_base/11_assert_usage.t t/10_units/03_base/12_assert_retval.t t/10_units/03_base/13_assert_data.t t/10_units/03_base/14_kernel.t t/10_units/03_base/15_kernel_internal.t t/10_units/03_base/16_nfa_usage.t t/10_units/03_base/17_detach_start.t t/10_units/04_drivers/01_sysrw.t t/10_units/05_filters/01_block.t t/10_units/05_filters/02_grep.t t/10_units/05_filters/03_http.t t/10_units/05_filters/04_line.t t/10_units/05_filters/05_map.t t/10_units/05_filters/06_recordblock.t t/10_units/05_filters/07_reference.t t/10_units/05_filters/08_stream.t t/10_units/05_filters/50_stackable.t t/10_units/05_filters/51_reference_die.t t/10_units/05_filters/99_filterchange.t t/10_units/05_filters/TestFilter.pm t/10_units/06_queues/01_array.t t/10_units/07_exceptions/01_normal.t t/10_units/07_exceptions/02_turn_off.t t/10_units/07_exceptions/03_not_handled.t t/10_units/08_loops/01_explicit_loop.t t/10_units/08_loops/02_explicit_loop_fail.t t/10_units/08_loops/03_explicit_loop_poll.t t/10_units/08_loops/04_explicit_loop_envvar.t t/10_units/08_loops/05_kernel_loop.t t/10_units/08_loops/06_kernel_loop_poll.t t/10_units/08_loops/07_kernel_loop_fail.t t/10_units/08_loops/08_kernel_loop_search_poll.t t/10_units/08_loops/09_naive_loop_load.t t/10_units/08_loops/10_naive_loop_load_poll.t t/10_units/08_loops/11_double_loop.t t/20_resources/00_base/aliases.pm t/20_resources/00_base/caller_state.pm t/20_resources/00_base/events.pm t/20_resources/00_base/extrefs.pm t/20_resources/00_base/extrefs_gc.pm t/20_resources/00_base/filehandles.pm t/20_resources/00_base/sessions.pm t/20_resources/00_base/sids.pm t/20_resources/00_base/signals.pm t/90_regression/agaran-filter-httpd.t t/90_regression/averell-callback-ret.t t/90_regression/bingos-followtail.t t/90_regression/broeren-win32-nbio.t t/90_regression/cfedde-filter-httpd.t t/90_regression/ferrari-server-unix.t t/90_regression/grinnz-die-in-die.t t/90_regression/hinrik-wheel-run-die.t t/90_regression/kjeldahl-stop-start-polling.t t/90_regression/kjeldahl-stop-start-sig-nopipe.t t/90_regression/kjeldahl-stop-start-sig-pipe.t t/90_regression/leolo-sig-die.t t/90_regression/meh-startstop-return.t t/90_regression/neyuki_detach.t t/90_regression/pipe-followtail.t t/90_regression/prumike-win32-stat.t t/90_regression/rt14444-arg1.t t/90_regression/rt1648-tied-stderr.t t/90_regression/rt19908-merlyn-stop.t t/90_regression/rt23181-sigchld-rc.t t/90_regression/rt47966-sigchld.t t/90_regression/rt56417-wheel-run.t t/90_regression/rt65460-forking.t t/90_regression/socketfactory-timeout.t t/90_regression/somni-poco-server-tcp.t t/90_regression/steinert-passed-wheel.t t/90_regression/suzman_windows.t t/90_regression/ton-stop-corruption.t t/90_regression/tracing-sane-exit.t t/90_regression/whelan-dieprop.t t/90_regression/whjackson-followtail.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) POE-1.370/Makefile.PL000644 001751 001751 00000013404 12500601177 014730 0ustar00bingosbingos000000 000000 #!/usr/bin/perl # rocco // vim: ts=2 sw=2 expandtab # Note to Dist::Zilla fans - This is NOT a standard Makefile.PL by ANY # stretch of the imagination. If you want to port it to Dist::Zilla, # you'll have a number of challenges ahead of you: # # - Custom Makefile.PL code. # # - Dynamic dependencies varying by $^O (see mylib/PoeBuildInfo.pm) # and by $] (see IPv6 dependencies below). # # - Dynamically generated tests. See PREOP in WriteMakefile(), below. # # - Custom Makefile target "coverage". See MY::postamble, below. # # I have tried using Dist::Zilla::Plugin::Makemaker::Awesome, but the # need to break encapsulation in order to make it work turned me away. # # People who love Dist::Zilla are welcome to replace this perfectly # fine Makefile.PL, but you should be aware of some requirements # before I'll accept the change: # # - Reproduce or improve upon all current Makefile.PL features. It's # all there for one reason or another. The reasons are still largely # pertinent. When in doubt, ask. # # - Limit your changes to replacing Makefile.PL and $VERSION. I'd # rather be able to rely on error message line numbers than to add # more moving parts to my build and test workflows. use strict; use ExtUtils::MakeMaker; use Config; use File::Spec; # Switch to default behavior if STDIN isn't a tty. unless (-t STDIN) { warn( "\n", "=============================================\n\n", "STDIN is not a terminal. Assuming --default.\n\n", "=============================================\n\n", ); push @ARGV, "--default"; } # Remind the user she can use --default. unless (grep /^--default$/, @ARGV) { warn( "\n", "=============================================\n\n", "Prompts may be bypassed by running:\n", " $^X $0 --default\n\n", "=============================================\n\n", ); } # Should we skip the network tests? my $prompt = ( "Some of POE's tests require a functional network.\n" . "You can skip these tests if you'd like.\n\n" . "Would you like to skip the network tests?" ); my $ret = "n"; if (grep /^--default$/, @ARGV) { print $prompt, " [$ret] $ret\n\n"; } else { $ret = prompt($prompt, "n"); } my $marker = 'run_network_tests'; unlink $marker; unless ($ret =~ /^Y$/i) { open(TOUCH,"+>$marker") and close TOUCH; } print "\n"; use lib qw(./mylib); use PoeBuildInfo qw( TEST_FILES CLEAN_FILES CORE_REQUIREMENTS DIST_ABSTRACT DIST_AUTHOR CONFIG_REQUIREMENTS HOMEPAGE REPOSITORY ); ### Touch files that will be generated at "make dist" time. ### ExtUtils::MakeMaker will complain about them if ### they aren't present now. open(TOUCH, ">>CHANGES") and close TOUCH; ### Touch gen-tests.perl so it always triggers. utime(time(), time(), "mylib/gen-tests.perl"); ### Some advisory dependency testing. sub check_for_modules { my ($dep_type, @modules) = @_; my @failures; while (@modules) { my $module = shift @modules; my $target = shift @modules; my $version = eval "use $module (); return \$$module\::VERSION"; if ($@) { push( @failures, "*** $module $target could not be loaded.\n" ); } elsif ($version < $target) { push( @failures, "*** $module $target is $dep_type, " . "but version $version is installed.\n" ); } } if (@failures) { warn( "*** Some $dep_type features may not be available:\n", @failures, ); } } check_for_modules("required", CORE_REQUIREMENTS); check_for_modules( "optional", "Compress::Zlib" => 1.33, "Curses" => 1.08, "IO::Poll" => 0.01, "IO::Pty" => 1.02, "LWP" => 5.79, "Term::Cap" => 1.10, "Term::ReadKey" => 2.21, "URI" => 1.30, ); # check for optional IPv6 stuff { # under perl-5.6.2 the warning "leaks" from the eval, while newer versions don't... # it's due to Exporter.pm behaving differently, so we have to shut it up no warnings 'redefine'; require Carp; local *Carp::carp = sub { die @_ }; # On perl-5.14.0 Socket.pm provides getaddrinfo # otherwise we need to use Socket::GetAddrInfo eval { require Socket; Socket->import("getaddrinfo") }; if ($@) { check_for_modules( "optional", "Socket::GetAddrInfo" => "0.20", ); } # On perl-5.14.0 Socket.pm provides the needed IPv6 constants # otherwise we need to use Socket6 eval { Socket->import( qw(AF_INET6 PF_INET6) ) }; if ($@) { check_for_modules( "optional", "Socket6" => "0.23", ); } } ### Generate Makefile.PL. sub MY::postamble { my $cov = File::Spec->catfile(mylib => 'coverage.perl'); return < 'POE', AUTHOR => DIST_AUTHOR, ABSTRACT => DIST_ABSTRACT, LICENSE => 'perl', CONFIGURE_REQUIRES => { CONFIG_REQUIREMENTS }, BUILD_REQUIRES => { CONFIG_REQUIREMENTS }, VERSION_FROM => 'lib/POE.pm', dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', PREOP => ( 'git-log.pl | ' . '/usr/bin/tee ./$(DISTNAME)-$(VERSION)/CHANGES > ./CHANGES; ' ), }, clean => { FILES => CLEAN_FILES }, test => { TESTS => TEST_FILES }, # Not executed on "make test". PL_FILES => { File::Spec->catfile(mylib => 'gen-tests.perl') => [ 'lib/POE.pm' ] }, PREREQ_PM => { CORE_REQUIREMENTS }, META_MERGE => { no_index => { directory => [ 'mylib' ], }, resources => { homepage => HOMEPAGE, license => 'http://dev.perl.org/licenses/', repository => REPOSITORY, }, }, # TODO - ExtUtils::MakeMaker doesn't generate 'provides'. # Module::Build did, but we're not using it anymore. ); 1; POE-1.370/META.yml000644 001751 001751 00000001716 14216613074 014237 0ustar00bingosbingos000000 000000 --- abstract: 'Portable, event-loop agnostic eventy networking and multitasking.' author: - 'Rocco Caputo ' build_requires: POE::Test::Loops: '1.360' configure_requires: POE::Test::Loops: '1.360' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.64, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: POE no_index: directory: - t - inc - mylib requires: Carp: '0' Errno: '1.09' Exporter: '0' File::Spec: '0.87' IO: '1.24' IO::Handle: '1.27' IO::Pipely: '0.005' IO::Tty: '1.08' POE::Test::Loops: '1.360' POSIX: '1.02' Socket: '1.7' Storable: '2.16' Test::Harness: '2.26' Time::HiRes: '1.59' resources: homepage: http://poe.perl.org/ license: http://dev.perl.org/licenses/ repository: https://github.com/rcaputo/poe version: '1.370' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' POE-1.370/META.json000644 001751 001751 00000003131 14216613074 014400 0ustar00bingosbingos000000 000000 { "abstract" : "Portable, event-loop agnostic eventy networking and multitasking.", "author" : [ "Rocco Caputo " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.64, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "POE", "no_index" : { "directory" : [ "t", "inc", "mylib" ] }, "prereqs" : { "build" : { "requires" : { "POE::Test::Loops" : "1.360" } }, "configure" : { "requires" : { "POE::Test::Loops" : "1.360" } }, "runtime" : { "requires" : { "Carp" : "0", "Errno" : "1.09", "Exporter" : "0", "File::Spec" : "0.87", "IO" : "1.24", "IO::Handle" : "1.27", "IO::Pipely" : "0.005", "IO::Tty" : "1.08", "POE::Test::Loops" : "1.360", "POSIX" : "1.02", "Socket" : "1.7", "Storable" : "2.16", "Test::Harness" : "2.26", "Time::HiRes" : "1.59" } } }, "release_status" : "stable", "resources" : { "homepage" : "http://poe.perl.org/", "license" : [ "http://dev.perl.org/licenses/" ], "repository" : { "url" : "https://github.com/rcaputo/poe" } }, "version" : "1.370", "x_serialization_backend" : "JSON::PP version 4.07" } POE-1.370/examples/sessions.perl000644 001751 001751 00000017075 12143730314 017335 0ustar00bingosbingos000000 000000 #!/usr/bin/perl -w # This is the first test program written for POE. It originally was # written to test POE's ability to dispatch events to inline sessions # (which was the only kind of sessions at the time). It was later # amended to test directly calling event handlers, delayed garbage # collection, and some other things that new developers probably don't # need to know. :) use strict; use lib '../lib'; # use POE always includes POE::Kernel and POE::Session, since they are # the fundamental POE classes and universally used. POE::Kernel # exports the $kernel global, a reference to the process' Kernel # instance. POE::Session exports a number of constants for event # handler parameter offsets. Some of the offsets are KERNEL, HEAP, # SESSION, and ARG0-ARG9. use POE; # stupid scope trick, part 1 of 3 parts my $session_name; #============================================================================== # This section defines the event handler (or state) subs for the # sessions that this program calls "child" sessions. Each sub does # just one thing, possibly passing execution to other event handlers # through one of the supported event-passing mechanisms. #------------------------------------------------------------------------------ # Newly created sessions are not ready to run until the kernel # registers them in its internal data structures. The kernel sends # every new session a _start event to tell them when they may begin. sub child_start { my ($kernel, $session, $heap) = @_[KERNEL, SESSION, HEAP]; # stupid scope trick, part 2 of 3 parts $heap->{'name'} = $session_name; $kernel->sig('INT', 'sigint'); my $sid = $session->ID(); print "Session $heap->{'name'} (SID $sid) started.\n"; return "i am $heap->{'name'} (SID $sid)"; } #------------------------------------------------------------------------------ # Every session receives a _stop event just prior to being removed # from memory. This allows sessions to perform last-minute cleanup. sub child_stop { my ($session, $heap) = @_[SESSION, HEAP]; my $sid = $session->ID(); print "Session $heap->{'name'} (SID $sid) stopped.\n"; } #------------------------------------------------------------------------------ # This sub handles a developer-supplied event. It accepts a name and # a count, increments the count, and displays some information. If # the count is small enough, it feeds back on itself by posting # another "increment" message. sub child_increment { my ($kernel, $session, $name, $count) = @_[KERNEL, SESSION, ARG0, ARG1]; $count++; if ($count % 2) { $kernel->state('runtime_state', \&child_runtime_state); } else { $kernel->state('runtime_state'); } my $sid = $session->ID(); print "Session $name (SID $sid), iteration $count...\n"; my $ret = $kernel->call($session, 'display_one', $name, $count); print "\t(display one returns: $ret)\n"; $ret = $kernel->call($session, 'display_two', $name, $count); print "\t(display two returns: $ret)\n"; if ($count < 5) { $kernel->post($session, 'increment', $name, $count); $kernel->yield('runtime_state', $name, $count); } } #------------------------------------------------------------------------------ # This state is added on every even count. It's removed on every odd # one. Every count posts an event here. sub child_runtime_state { my ($name, $iteration) = @_[ARG0, ARG1]; print( "Session $name received a runtime_state event ", "during iteration $iteration\n" ); } #------------------------------------------------------------------------------ # This sub handles a developer-supplied event. It is called (not # posted) immediately by the "increment" event handler. It displays # some information about its parameters, and returns a value. It is # included to test that $kernel->call() works properly. sub child_display_one { my ($name, $count) = @_[ARG0, ARG1]; print "\t(display one, $name, iteration $count)\n"; return $count * 2; } #------------------------------------------------------------------------------ # This sub handles a developer-supplied event. It is called (not # posted) immediately by the "increment" event handler. It displays # some information about its parameters, and returns a value. It is # included to test that $kernel->call() works properly. sub child_display_two { my ($name, $count) = @_[ARG0, ARG1]; print "\t(display two, $name, iteration $count)\n"; return $count * 3; } #------------------------------------------------------------------------------ # This event handler is a helper for child sessions. It returns the # session's name. Parent sessions should call it directly. sub child_fetch_name { $_[HEAP]->{'name'}; } #============================================================================== # This section defines the event handler (or state) subs for the # sessions that this program calls "parent" sessions. Each sub does # just one thing, possibly passing execution to other event handlers # through one of the supported event-passing mechanisms. #------------------------------------------------------------------------------ # Newly created sessions are not ready to run until the kernel # registers them in its internal data structures. The kernel sends # every new session a _start event to tell them when they may begin. sub main_start { my ($kernel, $heap) = @_[KERNEL, HEAP]; # start ten child sessions foreach my $name (qw(one two three four five six seven eight nine ten)) { # stupid scope trick, part 3 of 3 parts $session_name = $name; my $session = POE::Session->create( inline_states => { _start => \&child_start, _stop => \&child_stop, increment => \&child_increment, display_one => \&child_display_one, display_two => \&child_display_two, fetch_name => \&child_fetch_name, } ); # Normally, sessions are stopped if they have nothing to do. The # only exception to this rule is newly created sessions. Their # garbage collection is delayed slightly, so that parent sessions # may send them "bootstrap" events. The following post() call is # such a bootstrap event. $kernel->post($session, 'increment', $name, 0); } } #------------------------------------------------------------------------------ # POE's _stop events are not mandatory. sub main_stop { print "*** Main session stopped.\n"; } #------------------------------------------------------------------------------ # POE sends a _child event whenever a child session is about to # receive a _stop event (or has received a _start event). The # direction argument is either 'gain', 'lose' or 'create', to signify # whether the child is being given to, taken away from, or created by # the session (respectively). sub main_child { my ($kernel, $session, $direction, $child, $return) = @_[KERNEL, SESSION, ARG0, ARG1, ARG2]; my $sid = $session->ID(); print( "*** Main session (SID $sid) ${direction}s child ", $kernel->call($child, 'fetch_name'), (($direction eq 'create') ? " (child returns: $return)" : ''), "\n" ); } #============================================================================== # Start the main (parent) session, and begin processing events. # Kernel::run() will continue until there is nothing left to do. POE::Session->create( inline_states => { _start => \&main_start, _stop => \&main_stop, _child => \&main_child, } ); $poe_kernel->run(); exit; POE-1.370/examples/names.perl000644 001751 001751 00000025476 12143730314 016576 0ustar00bingosbingos000000 000000 #!/usr/bin/perl -w # Aliases were originally called Names. # Sessions with aliases will remain active even if they have nothing # to do. They still get SIGZOMBIE when all the other sessions run out # of things to do, so programs with aliased sessions won't run # forever. Aliases are mainly useful for creating "daemon" sessions # that can be called upon by other sessions. # This example is kind of obsolete. Session postbacks have been # created in the meantime, allowing it to totally avoid the kludgey # timer loops. use strict; use lib '../lib'; use POE; #============================================================================== # The LockDaemon package defines a session that provides simple # resource locking. This is only available within the current # process. package LockDaemon; use strict; use POE::Session; #------------------------------------------------------------------------------ # Create the LockDaemon. This illustrates non-POE objects that # register themselves with POE during construction. sub new { my $type = shift; my $self = bless { }, $type; # hello, world! print "> $self created\n"; # give this object to POE POE::Session->create( object_states => [ $self, [ qw(_start _stop lock unlock sighandler) ] ] ); # Don't let the caller have a reference. It's not very nice, but it # also prevents the caller from holding onto the reference and # possibly leaking memory. undef; } #------------------------------------------------------------------------------ # Destroy the server. This will happen after its POE::Session stops # and lets go of the object reference. sub DESTROY { my $self = shift; print "< $self destroyed\n"; } #------------------------------------------------------------------------------ # This method handles POE's standard _start message. It registers an # alias for the session, sets up signal handlers, and tells the world # what it has done. sub _start { my $kernel = $_[KERNEL]; # Set the alias. This really should check alias_set's return value, # but it's being lame. $kernel->alias_set('lockd'); # register signal handlers $kernel->sig('INT', 'sighandler'); $kernel->sig('IDLE', 'sighandler'); $kernel->sig('ZOMBIE', 'sighandler'); # hello, world! print "+ lockd started.\n"; } #------------------------------------------------------------------------------ # This method handles signals. It really only acknowledges that a # signal has been received. sub sighandler { my $signal_name = $_[ARG0]; print "@ lockd caught and handled SIG$signal_name\n"; # Returning a boolean true value indicates to the kernel that the # signal was handled. This usually means that the session will not # be stopped. return 1; } #------------------------------------------------------------------------------ # This method handles POE's standard _stop event. It cleans up after # the session by removing its alias. sub _stop { my ($object, $kernel, $heap) = @_[OBJECT, KERNEL, HEAP]; $kernel->alias_remove('lockd'); print "- lockd stopped.\n"; } #------------------------------------------------------------------------------ # Attempt to acquire a lock. This implements a very basic callback # protocol. If the lock can be acquired, the caller's $success state # is invoked. If the lock fails, the caller's $failure state is # invoked. It's up to the caller to keep itself alive, most likely # with a timeout event. sub lock { my ($kernel, $heap, $sender, $lock_name, $success, $failure) = @_[KERNEL, HEAP, SENDER, ARG0, ARG1, ARG2]; # if the lock already exists... if (exists $heap->{$lock_name}) { # ... check the current lock my ($owner, $time) = @{$heap->{$lock_name}}; # ... same owner? if ($owner eq $sender) { # ... ... refresh lock & succeed $heap->{$lock_name}->[1] = time(); $kernel->post($sender, $success); return 0; } # ... different owner? fail! $kernel->post($sender, $failure); return 0; } # no pre-existing lock; so acquire ok $heap->{$lock_name} = [ $sender, time() ]; $kernel->post($sender, $success); } #------------------------------------------------------------------------------ # Attempt to release a lock. This implements a very basic callback # protocol, similar to lock's. sub unlock { my ($kernel, $heap, $sender, $lock_name, $success, $failure) = @_[KERNEL, HEAP, SENDER, ARG0, ARG1, ARG2]; # if the lock exists... if (exists $heap->{$lock_name}) { # ... check the existing lock my ($owner, $time) = @{$heap->{$lock_name}}; # ... same owner? if ($owner eq $sender) { # ... ... release the lock & succeed delete $heap->{$lock_name}; $kernel->post($sender, $success); return 0; } } # no lock by that name; fail $kernel->post($sender, $failure); return 0; } #============================================================================== # The LockClient package defines a session that wants to do some # things to a resource that it must hold a lock for, and some other # things when it doesn't need to hold a lock. package LockClient; use strict; use POE::Session; #------------------------------------------------------------------------------ # Create the LockClient. This also illustrates non-POE objects that # register themselves with POE during construction. The LockDaemon # constructor is better documented, though. sub new { my ($type, $name) = @_; my $self = bless { 'name' => $name }, $type; # hello, world! print "> $self created\n"; # give this object to POE POE::Session->create( object_states => [ $self, [ qw(_start _stop acquire_lock retry_acquire release_lock retry_release perform_locked_operation perform_unlocked_operation ) ], ] ); # it will manage itself, thank you undef; } #------------------------------------------------------------------------------ # Destroy the client. This will happen after its POE::Session stops # and lets go of the object reference. sub DESTROY { my $self = shift; print "< $self destroyed\n"; } #------------------------------------------------------------------------------ # This method handles POE's standard _start message. It starts the # client's main loop by first performing an operation without holding # a lock. sub _start { my ($kernel, $session, $object) = @_[KERNEL, SESSION, OBJECT]; # display some impressive output :) print "+ client $object->{'name'} started\n"; # move to the next state in the cycle $kernel->post($session, 'perform_unlocked_operation'); } #------------------------------------------------------------------------------ # This method handles POE's standard _stop message. Normally it would # clean up any resources it has allocated, but this test doesn't care. sub _stop { my $object = $_[OBJECT]; print "+ client $object->{'name'} stopped\n"; } #------------------------------------------------------------------------------ # This is a cheezy hack to keep the session alive while it waits for # the lock daemon to respond. All it does is wake up every ten # seconds and set another alarm. sub timer_loop { my ($object, $kernel) = @_[OBJECT, KERNEL]; print "*** client $object->{'name'} alarm rang\n"; $kernel->delay('timer_loop', 10); } #------------------------------------------------------------------------------ # Attempt to acquire a lock. sub acquire_lock { my ($object, $kernel) = @_[OBJECT, KERNEL]; print "??? client $object->{'name'} attempting to acquire lock...\n"; # retry after waiting a little while $kernel->delay('acquire_lock', 10); # uses the lock daemon's protocol $kernel->post('lockd', 'lock', 'lock name', 'perform_locked_operation', 'retry_acquire' ); } #------------------------------------------------------------------------------ # Acquire failed. Wait one second and retry. sub retry_acquire { my ($object, $kernel) = @_[OBJECT, KERNEL]; print "--- client $object->{'name'} acquire failed... retrying...\n"; $kernel->delay('acquire_lock', 1); } #------------------------------------------------------------------------------ # Attempt to release a held lock. sub release_lock { my ($object, $kernel) = @_[OBJECT, KERNEL]; print "??? client $object->{'name'} attempting to release lock...\n"; # retry after waiting a little while $kernel->delay('release_lock', 10); $kernel->post('lockd', 'unlock', 'lock name', 'perform_unlocked_operation', 'retry_release' ); } #------------------------------------------------------------------------------ # Release failed. Wait one second and retry. sub retry_release { my ($object, $kernel) = @_[OBJECT, KERNEL]; print "--- client $object->{'name'} release failed... retrying...\n"; $kernel->delay('release_lock', 1); } #------------------------------------------------------------------------------ # Do something while holding the lock. sub perform_locked_operation { my ($object, $kernel) = @_[OBJECT, KERNEL]; # clear the alarm! $kernel->delay('acquire_lock'); print "+++ client $object->{'name'} acquired lock... processing...\n"; $kernel->delay('release_lock', 1); } #------------------------------------------------------------------------------ # Do something while not holding the lock. sub perform_unlocked_operation { my ($object, $kernel) = @_[OBJECT, KERNEL]; # clear the alarm! $kernel->delay('release_lock'); print "+++ client $object->{'name'} released lock... processing...\n"; $kernel->delay('acquire_lock', 1); } #============================================================================== # Create the lock daemon and five clients. Run them until someone # sends a SIGINT. package main; # start the lock daemon LockDaemon->new(); # start the clients foreach (1..5) { LockClient->new($_); } # run until it's time to stop $poe_kernel->run(); exit; POE-1.370/examples/create.perl000644 001751 001751 00000017477 12143730314 016740 0ustar00bingosbingos000000 000000 #!/usr/bin/perl -w # This is a version of sessions.perl that uses the &Session::create # constructor. use strict; use lib '../lib'; # use POE always includes POE::Kernel and POE::Session, since they are # the fundamental POE classes and universally used. POE::Kernel # exports the $kernel global, a reference to the process' Kernel # instance. POE::Session exports a number of constants for event # handler parameter offsets. Some of the offsets are KERNEL, HEAP, # SESSION, and ARG0-ARG9. use POE; # stupid scope trick, part 1 of 3 parts my $session_name; #============================================================================== # This section defines the event handler (or state) subs for the # sessions that this program calls "child" sessions. Each sub does # just one thing, possibly passing execution to other event handlers # through one of the supported event-passing mechanisms. #------------------------------------------------------------------------------ # Newly created sessions are not ready to run until the kernel # registers them in its internal data structures. The kernel sends # every new session a _start event to tell them when they may begin. sub child_start { my ($kernel, $heap) = @_[KERNEL, HEAP]; # stupid scope trick, part 2 of 3 parts $heap->{'name'} = $session_name; $kernel->sig('INT', 'sigint'); print "Session $heap->{'name'} started.\n"; return "i am $heap->{'name'}"; } #------------------------------------------------------------------------------ # Every session receives a _stop event just prior to being removed # from memory. This allows sessions to perform last-minute cleanup. sub child_stop { my $heap = $_[HEAP]; print "Session ", $heap->{'name'}, " stopped.\n"; } #------------------------------------------------------------------------------ # This sub handles a developer-supplied event. It accepts a name and # a count, increments the count, and displays some information. If # the count is small enough, it feeds back on itself by posting # another "increment" message. sub child_increment { my ($kernel, $me, $name, $count) = @_[KERNEL, SESSION, ARG0, ARG1]; $count++; print "Session $name, iteration $count...\n"; my $ret = $kernel->call($me, 'display_one', $name, $count); print "\t(display one returns: $ret)\n"; $ret = $kernel->call($me, 'display_two', $name, $count); print "\t(display two returns: $ret)\n"; if ($count < 5) { $kernel->post($me, 'increment', $name, $count); } } #------------------------------------------------------------------------------ # This sub handles a developer-supplied event. It is called (not # posted) immediately by the "increment" event handler. It displays # some information about its parameters, and returns a value. It is # included to test that $kernel->call() works properly. sub child_display_one { my ($name, $count) = @_[ARG0, ARG1]; print "\t(display one, $name, iteration $count)\n"; return $count * 2; } #------------------------------------------------------------------------------ # This sub handles a developer-supplied event. It is called (not # posted) immediately by the "increment" event handler. It displays # some information about its parameters, and returns a value. It is # included to test that $kernel->call() works properly. sub child_display_two { my ($name, $count) = @_[ARG0, ARG1]; print "\t(display two, $name, iteration $count)\n"; return $count * 3; } #------------------------------------------------------------------------------ # This event handler is a helper for child sessions. It returns the # session's name. Parent sessions should call it directly. sub child_fetch_name { $_[HEAP]->{'name'}; } #============================================================================== # Define an object for object sessions. package Counter; sub new { my $type = shift; my $self = bless [], $type; $self; } sub _start { goto &main::child_start } sub _stop { goto &main::child_stop } sub increment { goto &main::child_increment } sub display_one { goto &main::child_display_one } sub display_two { goto &main::child_display_two } sub fetch_name { goto &main::child_fetch_name } #============================================================================== # This section defines the event handler (or state) subs for the # sessions that this program calls "parent" sessions. Each sub does # just one thing, possibly passing execution to other event handlers # through one of the supported event-passing mechanisms. package main; #------------------------------------------------------------------------------ # Newly created sessions are not ready to run until the kernel # registers them in its internal data structures. The kernel sends # every new session a _start event to tell them when they may begin. sub main_start { my ($kernel, $heap) = @_[KERNEL, HEAP]; # start ten child sessions foreach my $name (qw(one two three four five)) { # stupid scope trick, part 3 of 3 parts $session_name = $name; my $session = POE::Session->create ( inline_states => { _start => \&child_start, _stop => \&child_stop, increment => \&child_increment, display_one => \&child_display_one, display_two => \&child_display_two, fetch_name => \&child_fetch_name, } ); # Normally, sessions are stopped if they have nothing to do. The # only exception to this rule is newly created sessions. Their # garbage collection is delayed slightly, so that parent sessions # may send them "bootstrap" events. The following post() call is # such a bootstrap event. $kernel->post($session, 'increment', $name, 0); } foreach my $name (qw(six seven eight nine ten)) { # stupid scope trick, part 4 of 3 parts (that just shows you how # stupid it is) $session_name = $name; my $session = POE::Session->create ( object_states => [ new Counter, [ '_start', '_stop', 'increment', 'display_one', 'display_two', 'fetch_name', ], ], ); # Normally, sessions are stopped if they have nothing to do. The # only exception to this rule is newly created sessions. Their # garbage collection is delayed slightly, so that parent sessions # may send them "bootstrap" events. The following post() call is # such a bootstrap event. $kernel->post($session, 'increment', $name, 0); } } #------------------------------------------------------------------------------ # POE's _stop events are not mandatory. sub main_stop { print "*** Main session stopped.\n"; } #------------------------------------------------------------------------------ # POE sends a _child event whenever a child session is about to # receive a _stop event (or has received a _start event). The # direction argument is either 'gain', 'lose' or 'create', to signify # whether the child is being given to, taken away from, or created by # the session (respectively). sub main_child { my ($kernel, $me, $direction, $child, $return) = @_[KERNEL, SESSION, ARG0, ARG1, ARG2]; print( "*** Main session ${direction}s child ", $kernel->call($child, 'fetch_name'), (($direction eq 'create') ? " (child returns: $return)" : ''), "\n" ); } #============================================================================== # Start the main (parent) session, and begin processing events. # Kernel::run() will continue until there is nothing left to do. create POE::Session ( inline_states => { _start => \&main_start, _stop => \&main_stop, _child => \&main_child, } ); $poe_kernel->run(); exit; POE-1.370/examples/queue.perl000644 001751 001751 00000010156 12143730314 016604 0ustar00bingosbingos000000 000000 #!/usr/bin/perl -w # This is a simple job queue. use strict; use lib '../lib'; # sub POE::Kernel::TRACE_DEFAULT () { 1 } # sub POE::Kernel::TRACE_GARBAGE () { 1 } # sub POE::Kernel::ASSERT_DEFAULT () { 1 } use POE; ### Configuration section. # This is the maximum number of children permitted to be running at # any moment. my $child_max = 5; ### This is a "child" session. The "parent" session will ensure that ### $child_max of these are running at any given time. # The parent session needs to create children from two places. Define # a handy constructor rather than maintain duplicate copies of this # POE::Session->create call. sub create_a_child { POE::Session->create ( inline_states => { _start => \&child_start, _stop => \&child_stop, wake_up => \&child_awaken, }, ); } # The child session has started. Pretend to do something for a random # amount of time. sub child_start { my ($kernel, $session, $parent, $heap) = @_[KERNEL, SESSION, SENDER, HEAP]; # Remember the parent. $heap->{parent} = $parent; # Take a random amount of time to "do" the "job". my $delay = int rand 10; warn "Child ", $session->ID, " will take $delay seconds to run.\n"; $kernel->delay( wake_up => $delay ); } # The child has finished whatever it was supposed to do. Send the # result of its labor back to the parent. sub child_awaken { my ($kernel, $session, $heap) = @_[KERNEL, SESSION, HEAP]; # Fabricate the hypothetical job's result. my $result = int rand 100; warn "Child ", $session->ID, " is done doing something. Result=$result\n"; # Post the result back to the parent. The child has nothing left to # do, and so it stops. $kernel->post($heap->{parent}, 'result', $session->ID, $result); } # The child has stopped. Display a message to help illustrate what's # going on. sub child_stop { my $session = $_[SESSION]; warn "Child ", $session->ID, " is stopped.\n"; } ### This is the "parent" session. One of these will ensure that ### $child_max children are running beneath it. It's possible to have ### several parent sessions; each will manage a separate pool of ### children. # The parent session is starting. Populate its pool with an initial # group of child sessions. sub parent_start { $_[HEAP]->{child_count} = 0; for (my $i=0; $i<$child_max; $i++) { &create_a_child; } } # The parent has either gained a new child or lost an existing one. # If a new child is gained, track it. If an existing child is lost, # then spawn a replacement. sub parent_child { my ($heap, $what, $child) = @_[HEAP, ARG0, ARG1]; # This child is arriving, either by being created or by being # abandoned by some other session. Count it as a child in our pool. if ($what eq 'create' or $what eq 'gain') { $heap->{child_count}++; warn( "Child ", $child->ID, " has appeared to parent ", $_[SESSION]->ID, " (", $heap->{child_count}, " active children now).\n" ); } # This child is departing. Remove it from our pool count; if we # have fewer children than $child_max, then spawn a new one to take # the departing child's place. elsif ($what eq 'lose') { $heap->{child_count}--; warn( "Child ", $child->ID, " has left parent ", $_[SESSION]->ID, " (", $heap->{child_count}, " active children now).\n" ); if ($heap->{child_count} < $child_max) { &create_a_child; } } } # Receive a child session's result. sub parent_result { my ($child, $result) = @_[ARG0, ARG1]; warn "Parent received result from session $child: $result\n"; } # Track when the parent leaves. sub parent_stop { warn "Parent ", $_[SESSION]->ID, " stopped.\n"; } ### Main loop. Start a parent session, which will, in turn, start its ### children. Run until everything is done; in this case, until the ### user presses Ctrl+C. Note: The children which are currently ### "working" will continue after Ctrl+C until they are "done". POE::Session->create ( inline_states => { _start => \&parent_start, _stop => \&parent_stop, _child => \&parent_child, result => \&parent_result, } ); $poe_kernel->run(); exit; POE-1.370/examples/objmaps.perl000644 001751 001751 00000011003 12143730314 017103 0ustar00bingosbingos000000 000000 #!/usr/bin/perl -w # This is another simple functionality test. It tests sessions that # are composed of objects (also called "object sessions"). The # difference between this and objsessions.perl is that the object # method names do not match their state names. use strict; use lib '../lib'; use POE; #============================================================================== # Counter is an object that roughly approximates "child" sessions from # the sessions.perl test. It counts for a little while, then stops. package Counter; use strict; use POE::Session; #------------------------------------------------------------------------------ # This is a normal Perl object method. It creates a new Counter # instance and returns a reference to it. It's also possible for the # object to wrap itself in a Session within the constructor. # Self-wrapping objects are explored in other examples. sub new { my ($type, $name) = @_; print "Session ${name}'s object created.\n"; bless { 'name' => $name }, $type; } #------------------------------------------------------------------------------ # This is a normal Perl object method. It destroys a Counter object, # doing any late cleanup on the object. This is different than the # _stop event handler, which handles late cleanup on the object's # Session. sub DESTROY { my $self = shift; print "Session $self->{name}'s object destroyed.\n"; } #------------------------------------------------------------------------------ # This method is an event handler. It sets the session in motion # after POE sends the standard _start event. sub poe_start { my ($object, $session, $heap, $kernel) = @_[OBJECT, SESSION, HEAP, KERNEL]; # register a signal handler $kernel->sig('INT', 'sigint'); # initialize the counter $heap->{'counter'} = 0; # hello, world! print "Session $object->{'name'} started.\n"; $kernel->post($session, 'increment'); } #------------------------------------------------------------------------------ # This method is an event handler, too. It cleans up after receiving # POE's standard _stop event. sub poe_stop { my ($object, $kernel, $heap) = @_[OBJECT, KERNEL, HEAP]; print "Session $object->{'name'} stopped after $heap->{'counter'} loops.\n"; } #------------------------------------------------------------------------------ # This method is an event handler. It will be registered as a SIGINT # handler so that the session can acknowledge the signal. sub poe_sigint { my ($object, $from, $signal_name) = @_[OBJECT, SENDER, ARG0]; print "$object->{'name'} caught SIG$signal_name from $from\n"; # did not handle the signal return 0; } #------------------------------------------------------------------------------ # This method is an event handler. It does most of counting work. It # loops by posting events back to itself. The session exits when # there is nothing left to do; this event handler causes that # condition when it stops posting events. sub poe_increment { my ($object, $kernel, $session, $heap) = @_[OBJECT, KERNEL, SESSION, HEAP]; $heap->{'counter'}++; if ($heap->{counter} % 2) { $kernel->state('runtime_state', $object, 'poe_runtime_state'); } else { $kernel->state('runtime_state'); } print "Session $object->{'name'}, iteration $heap->{'counter'}.\n"; if ($heap->{'counter'} < 5) { $kernel->post($session, 'increment'); $kernel->yield('runtime_state', $heap->{counter}); } else { # no more events. since there is nothing left to do, the session exits. } } #------------------------------------------------------------------------------ # This state is added on every even count. It's removed on every odd # one. Every count posts an event here. sub poe_runtime_state { my ($self, $iteration) = @_[OBJECT, ARG0]; print( 'Session ', $self->{name}, ' received a runtime_state event during iteration ', $iteration, "\n" ); } #============================================================================== # Create ten Counter objects, and wrap them in sessions. package main; foreach my $name (qw(one two three four five six seven eight nine ten)) { POE::Session->create( object_states => [ Counter->new($name) => { _start => 'poe_start', _stop => 'poe_stop', increment => 'poe_increment', sigint => 'poe_sigint', }, ], ); } $poe_kernel->run(); exit; POE-1.370/examples/signals.perl000644 001751 001751 00000010526 12276766765 017153 0ustar00bingosbingos000000 000000 #!/usr/bin/perl -w # This program tests signals. It tests OS signals (such as SIGINT), # soft signals to sessions, and soft signals to kernels. Soft # signals, by the way, are ones generated with the Kernel::signal() # function. They don't involve the underlying OS, and so can send # arbitrarily named signals. use strict; use lib '../lib'; use POE; #============================================================================== # This is a pathological example of an inline session. It defines the # subs for each event handler within the POE::Session constructor's # parameters. It's not bad for quick hacks. # # Anyway, this session registers handlers for SIGINT and two # fictitious signals (SIGFOO and SIGQUUX). The session then starts an # alarm loop that signals FOO to itself once a second. POE::Session->create( inline_states => { ### _start the session '_start' => sub{ my $kernel = $_[KERNEL]; # register signal handlers $kernel->sig('INT', 'signal handler'); $kernel->sig('FOO', 'signal handler'); $kernel->sig('QUUX', 'signal handler'); # hello, world! print "First session started... send SIGINT to stop.\n"; # start the alarm loop $kernel->delay('set an alarm', 1); }, ### _stop the session '_stop' => sub { print "First session stopped.\n"; }, ### alarm handler 'set an alarm' => sub { my ($kernel, $session) = @_[KERNEL, SESSION]; print "First session's alarm rang. Sending SIGFOO to itself...\n"; # send a signal to itself $kernel->signal($session, 'FOO'); # reset the alarm for 1s from now $kernel->delay('set an alarm', 1); }, ### signal handler 'signal handler' => sub { my ($kernel, $signal_name) = @_[KERNEL, ARG0]; print "First session caught SIG$signal_name\n"; # stop pending alarm on SIGINT if ($signal_name eq 'INT') { print "First session stopping...\n"; $kernel->delay('set an alarm'); } }, } ); #============================================================================== # This is another pathological inline session. This one registers # handlers for SIGINT and two fictitious signals (SIGBAZ and SIGQUUX). # The session then starts an alarm loop that signals QUUX to the # kernel twice a second. This propagates SIGQUUX to every session. POE::Session->create( inline_states => { ### _start the session '_start' => sub { my $kernel = $_[KERNEL]; # register signal handlers $kernel->sig('INT', 'signal handler'); $kernel->sig('BAZ', 'signal handler'); $kernel->sig('QUUX', 'signal handler'); # hello, world! print "Second session started... send SIGINT to stop.\n"; # start the alarm loop $kernel->delay('set an alarm', 0.5); }, ### _stop the session '_stop' => sub { print "Second session stopped.\n"; }, ### alarm handler 'set an alarm' => sub { my $kernel = $_[KERNEL]; print "Second session's alarm rang. Sending SIGQUUX to kernel...\n"; # signal the kernel $kernel->signal($kernel, 'QUUX'); # reset the alarm for 1/2s from now $kernel->delay('set an alarm', 0.5); }, ### signal handler 'signal handler' => sub { my ($kernel, $signal_name) = @_[KERNEL, ARG0]; print "Second session caught SIG$signal_name\n"; # stop pending alarm on SIGINT if ($signal_name eq 'INT') { print "Second session stopping...\n"; $kernel->delay('set an alarm'); } }, } ); #============================================================================== # Tell the kernel to run the sessions. $poe_kernel->run(); exit; POE-1.370/examples/objsessions.perl000644 001751 001751 00000010447 12143730314 020024 0ustar00bingosbingos000000 000000 #!/usr/bin/perl -w # This is another simple functionality test. It tests sessions that # are composed of objects (also called "object sessions"). It is # simpler than sessions.perl in many ways. use strict; use lib '../lib'; use POE; #============================================================================== # Counter is an object that roughly approximates "child" sessions from # the sessions.perl test. It counts for a little while, then stops. package Counter; use strict; use POE::Session; #------------------------------------------------------------------------------ # This is a normal Perl object method. It creates a new Counter # instance and returns a reference to it. It's also possible for the # object to wrap itself in a Session within the constructor. # Self-wrapping objects are explored in other examples. sub new { my ($type, $name) = @_; print "Session ${name}'s object created.\n"; bless { 'name' => $name }, $type; } #------------------------------------------------------------------------------ # This is a normal Perl object method. It destroys a Counter object, # doing any late cleanup on the object. This is different than the # _stop event handler, which handles late cleanup on the object's # Session. sub DESTROY { my $self = shift; print "Session $self->{name}'s object destroyed.\n"; } #------------------------------------------------------------------------------ # This method is an event handler. It sets the session in motion # after POE sends the standard _start event. sub _start { my ($object, $session, $heap, $kernel) = @_[OBJECT, SESSION, HEAP, KERNEL]; # register a signal handler $kernel->sig('INT', 'sigint'); # initialize the counter $heap->{'counter'} = 0; # hello, world! print "Session $object->{'name'} started.\n"; $kernel->post($session, 'increment'); } #------------------------------------------------------------------------------ # This method is an event handler, too. It cleans up after receiving # POE's standard _stop event. sub _stop { my ($object, $kernel, $heap) = @_[OBJECT, KERNEL, HEAP]; print "Session $object->{'name'} stopped after $heap->{'counter'} loops.\n"; } #------------------------------------------------------------------------------ # This method is an event handler. It will be registered as a SIGINT # handler so that the session can acknowledge the signal. sub sigint { my ($object, $from, $signal_name) = @_[OBJECT, SENDER, ARG0]; print "$object->{'name'} caught SIG$signal_name from $from\n"; # did not handle the signal return 0; } #------------------------------------------------------------------------------ # This method is an event handler. It does most of counting work. It # loops by posting events back to itself. The session exits when # there is nothing left to do; this event handler causes that # condition when it stops posting events. sub increment { my ($object, $kernel, $session, $heap) = @_[OBJECT, KERNEL, SESSION, HEAP]; $heap->{'counter'}++; if ($heap->{counter} % 2) { $kernel->state('runtime_state', $object); } else { $kernel->state('runtime_state'); } print "Session $object->{'name'}, iteration $heap->{'counter'}.\n"; if ($heap->{'counter'} < 5) { $kernel->post($session, 'increment'); $kernel->yield('runtime_state', $heap->{counter}); } else { # no more events. since there is nothing left to do, the session exits. } } #------------------------------------------------------------------------------ # This state is added on every even count. It's removed on every odd # one. Every count posts an event here. sub runtime_state { my ($self, $iteration) = @_[OBJECT, ARG0]; print( 'Session ', $self->{name}, ' received a runtime_state event during iteration ', $iteration, "\n" ); } #============================================================================== # Create ten Counter objects, and wrap them in sessions. package main; foreach my $name (qw(one two three four five six seven eight nine ten)) { POE::Session->create( object_states => [ Counter->new($name) => [ qw(_start _stop increment sigint) ] ], ); } $poe_kernel->run(); exit; POE-1.370/examples/forkbomb.perl000644 001751 001751 00000013716 12143730314 017266 0ustar00bingosbingos000000 000000 #!/usr/bin/perl -w -I.. # This is another of the earlier test programs. It creates a single # session whose job is to create more of itself. There is a built-in # limit of 200 sessions, after which they all politely stop. # This program's main purpose in life is to test POE's parent/child # relationships, signal propagation and garbage collection. use strict; use lib '../lib'; sub POE::Kernel::ASSERT_DEFAULT () { 1 } use POE; #============================================================================== # These subs implement the guts of a forkbomb session. Its only # mission in life is to spawn more of itself until it dies. my $count = 0; # session counter for limiting runtime #------------------------------------------------------------------------------ # This sub handles POE's standard _start event. It initializes the # session. sub _start { my ($kernel, $heap) = @_[KERNEL, HEAP]; # assign the next count to this session $heap->{'id'} = ++$count; printf "%4d has started.\n", $heap->{'id'}; # register signal handlers $kernel->sig('INT', 'signal_handler'); $kernel->sig('ZOMBIE', 'signal_handler'); # start forking $kernel->yield('fork'); # return something interesting return "i am $heap->{'id'}"; } #------------------------------------------------------------------------------ # This sub handles POE's standard _stop event. It acknowledges that # the session is stopped. sub _stop { printf "%4d has stopped.\n", $_[HEAP]->{'id'}; } #------------------------------------------------------------------------------ # This sub handles POE's standard _child event. It acknowledges that # the session is gaining or losing a child session. my %english = ( lose => 'is losing', gain => 'is gaining', create => 'has created' ); sub _child { my ($kernel, $heap, $direction, $child, $return) = @_[KERNEL, HEAP, ARG0, ARG1, ARG2]; printf( "%4d %s child %s%s\n", $heap->{'id'}, $english{$direction}, $kernel->call($child, 'fetch_id'), (($direction eq 'create') ? (" (child returned: $return)") : '') ); } #------------------------------------------------------------------------------ # This sub handles POE's standard _parent event. It acknowledges that # the child session's parent is changing. sub _parent { my ($kernel, $heap, $old_parent, $new_parent) = @_[KERNEL, HEAP, ARG0, ARG1]; printf( "%4d parent is changing from %d to %d\n", $heap->{'id'}, $kernel->call($old_parent, 'fetch_id'), $kernel->call($new_parent, 'fetch_id') ); } #------------------------------------------------------------------------------ # This sub acknowledges receipt of signals. It's registered as the # handler for SIGINT and SIGZOMBIE. It returns 0 to tell the kernel # that the signals were not handled. This causes the kernel to stop # the session for certain "terminal" signals (such as SIGINT). sub signal_handler { my ($heap, $signal_name) = @_[HEAP, ARG0]; printf( "%4d has received SIG%s\n", $heap->{'id'}, $signal_name); # tell Kernel that this wasn't handled return 0; } #------------------------------------------------------------------------------ # This is the main part of the test. This state uses the yield() # function to loop until certain conditions are met. my $max_sessions = 200; my $half_sessions = int($max_sessions / 2); sub fork { my ($kernel, $heap) = @_[KERNEL, HEAP]; # Only consider continuing if the maximum number of sessions has not # yet been reached. if ($count < $max_sessions) { # flip a coin; heads == spawn if (rand() < 0.5) { printf "%4d is starting a new child...\n", $heap->{'id'}; &create_new_forkbomber(); } # tails == don't spawn else { printf "%4d is just spinning its wheels this time...\n", $heap->{'id'}; } # Randomly decide to die (or not) if half the sessions have been # reached. if (($count < $half_sessions) || (rand() < 0.05)) { $kernel->yield('fork'); } else { printf "%4d has decided to die. Bye!\n", $heap->{'id'}; # NOTE: Child sessions will keep a parent session alive. # Because of this, the program forces a stop by sending itself a # _stop event. This normally isn't necessary. # NOTE: The main session (#1) is allowed to linger. This # prevents strange things from happening when it exits # prematurely. if ($heap->{'id'} != 1) { $kernel->yield('_stop'); } } } else { printf "%4d notes that the session limit is met. Bye!\n", $heap->{'id'}; # Please see the two NOTEs above. if ($heap->{'id'} != 1) { $kernel->yield('_stop'); } } } #------------------------------------------------------------------------------ # This is a helper event handler. It is called directly by parents # and children to help identify the sessions being given or taken # away. It is just a public interface to the session's numeric ID. sub fetch_id { return $_[HEAP]->{'id'}; } #============================================================================== # This is a helper function that creates a new forkbomber session. sub create_new_forkbomber { POE::Session->create( inline_states => { '_start' => \&_start, '_stop' => \&_stop, '_child' => \&_child, '_parent' => \&_parent, 'signal_handler' => \&signal_handler, 'fork' => \&fork, 'fetch_id' => \&fetch_id, } ); } #============================================================================== # Create the initial forkbomber session, and run the kernel. &create_new_forkbomber(); $poe_kernel->run(); exit; POE-1.370/examples/fakelogin.perl000644 001751 001751 00000012342 12143730314 017416 0ustar00bingosbingos000000 000000 #!/usr/bin/perl -w # This is a fake login prompt I wrote after noticing that someone's # IRC 'bot was probing telnet whenever I joined a particular channel. # It wasn't originally going to be a POE test, but it turns out to be # a good exercise for wheel event renaming. use strict; use lib '../lib'; use IO::Socket; use POE qw( Wheel::SocketFactory Wheel::ReadWrite Driver::SysRW Filter::Line Filter::Stream ); #============================================================================== # This is the login state group. #------------------------------------------------------------------------------ # Enter the "login" prompt state. Prompt user, and wait for input. sub login_login_start { my ($session, $heap) = @_[SESSION, HEAP]; print "Session ", $session->ID, " - entering login state\n"; # switch the output filter to stream $heap->{wheel}->set_output_filter( POE::Filter::Stream->new ); # switch the input event to login_input $heap->{wheel}->event( InputEvent => 'login_input' ); # display the prompt $heap->{wheel}->put('login: '); } sub login_login_input { my ($kernel, $session, $heap, $input) = @_[KERNEL, SESSION, HEAP, ARG0]; print "Session ", $session->ID, " - received login input\n"; if ($input ne '') { $kernel->yield('password_start'); } else { $kernel->yield('login_start'); } } #============================================================================== # This is the password state group. sub login_password_start { my ($session, $heap) = @_[SESSION, HEAP]; print "Session ", $session->ID, " - entering password state\n"; # switch output filter to stream $heap->{wheel}->set_output_filter( POE::Filter::Stream->new ); # switch input event to password_input $heap->{wheel}->event( InputEvent => 'password_input' ); # display the prompt $heap->{wheel}->put('Password: '); } sub login_password_input { my ($kernel, $session, $heap, $input) = @_[KERNEL, SESSION, HEAP, ARG0]; print "Session ", $session->ID, " - received password input\n"; # switch output filter to line $heap->{wheel}->set_output_filter( POE::Filter::Line->new ); # display the response $heap->{wheel}->put('Login incorrect'); # move to the login state $kernel->yield('login_start'); } sub login_error { my ($session, $heap, $operation, $errnum, $errstr) = @_[SESSION, HEAP, ARG0, ARG1, ARG2]; $errstr = 'Client closed connection' unless $errnum; print( "Session ", $session->ID, ": login: $operation error $errnum: $errstr\n" ); delete $heap->{wheel}; } #============================================================================== # This is the main entry point for the login session. sub login_session_start { my ($kernel, $session, $heap, $handle, $peer_addr, $peer_port) = @_[KERNEL, SESSION, HEAP, ARG0, ARG1, ARG2]; print "Session ", $session->ID, " - received connection\n"; # start reading and writing $heap->{wheel} = POE::Wheel::ReadWrite->new( 'Handle' => $handle, 'Driver' => POE::Driver::SysRW->new, 'Filter' => POE::Filter::Line->new, 'ErrorEvent' => 'error', ); # hello, world!\n $heap->{wheel}->put('FreeBSD (localhost) (ttyp2)', '', ''); $kernel->yield('login_start'); } sub login_session_create { my ($handle, $peer_addr, $peer_port) = @_[ARG0, ARG1, ARG2]; POE::Session->create( inline_states => { _start => \&login_session_start, # general error handler error => \&login_error, # login prompt states login_start => \&login_login_start, login_input => \&login_login_input, # password prompt states password_start => \&login_password_start, password_input => \&login_password_input, }, # start parameters args => [ $handle, $peer_addr, $peer_port], ); undef; } #============================================================================== package main; my $port = shift; if (not defined $port) { print( "*** This program listens on port 23 by default. You can change\n", "*** the port by putting a new one on the command line. For\n", "*** example, to listen on port 10023:\n", "*** $0 10023\n", ); $port = 23; } POE::Session->create( inline_states => { '_start' => sub { my $heap = $_[HEAP]; $heap->{wheel} = POE::Wheel::SocketFactory->new( BindPort => $port, SuccessEvent => 'socket_ok', FailureEvent => 'socket_error', Reuse => 'yes', ); }, 'socket_error' => sub { my ($session, $heap, $operation, $errnum, $errstr) = @_[SESSION, HEAP, ARG0, ARG1, ARG2]; print( "Session ", $session->ID, ": listener: $operation error $errnum: $errstr\n" ); }, 'socket_ok' => \&login_session_create, }, ); $poe_kernel->run(); __END__ POE-1.370/examples/thrash.perl000644 001751 001751 00000041661 12143730314 016756 0ustar00bingosbingos000000 000000 #!/usr/bin/perl -w # This program creates a server session and an infinitude of clients # that connect to it, all in the same process. It's mainly used to # test for memory leaks, but it's also something of a benchmark. # It is possible to split this program into two separate processes: # Change $server_addr to something appropriate. # Make a second copy of this program. # In the "server" copy, comment out the call to &pool_create(); # In the "client" copy, comment out th ecall to &server_create(); use strict; use lib '../lib'; use Socket; #sub POE::Kernel::ASSERT_DEFAULT () { 1 } use POE qw(Wheel::ListenAccept Wheel::ReadWrite Driver::SysRW Filter::Line Wheel::SocketFactory ); sub MAX_SIMULTANEOUS_CLIENTS () { 5 } # make 1 to enable output sub DEBUG () { 0 } # address and port the server binds to my $server_addr = '127.0.0.1'; my $server_port = 32100; ############################################################################### # This is a single client session. It uses two separator wheels: a # SocketFactory to establish a connection, and a ReadWrite to process # data once the connection is made #------------------------------------------------------------------------------ # This is regular Perl sub that helps create new clients. It's not an # event handler. sub client_create { my $serial_number = shift; # create the session POE::Session->create( inline_states => { _start => \&client_start, _stop => \&client_stop, receive => \&client_receive, error => \&client_error, connected => \&client_connected, signals => \&client_signals, _parent => sub {}, }, # ARG0 args => [ $serial_number ] ); } #------------------------------------------------------------------------------ # Accept POE's standard _start event, and create a non-blocking client # socket. sub client_start { my ($kernel, $heap, $serial) = @_[KERNEL, HEAP, ARG0]; DEBUG && print "Client $serial is starting.\n"; # remember this client's serial number $heap->{'serial'} = $serial; # watch for SIGINT $kernel->sig('INT', 'signals'); # create a socket factory $heap->{'wheel'} = POE::Wheel::SocketFactory->new( RemoteAddress => $server_addr, # connecting to address $server_addr RemotePort => $server_port, # connecting to port $server_port SuccessEvent => 'connected', # generating this event when connected FailureEvent => 'error', # generating this event upon an error ); } #------------------------------------------------------------------------------ # Accept POE's standard _stop event. This normally would clean up the # session, but this program doesn't keep anything in the heap that # needs to be cleaned up. sub client_stop { my $heap = $_[HEAP]; DEBUG && print "Client $heap->{'serial'} has stopped.\n"; } #------------------------------------------------------------------------------ # This event handler/state is invoked when a connection has been # established successfully. It replaces the SocketFactory wheel with # a ReadWrite wheel. The new wheel generates different events. sub client_connected { my ($heap, $socket) = @_[HEAP, ARG0]; die "possible filehandle leak" if fileno($socket) > 63; DEBUG && print "Client $heap->{'serial'} is connected.\n"; # switch to read/write behavior $heap->{'wheel'} = POE::Wheel::ReadWrite->new( Handle => $socket, # read and write on this socket Driver => POE::Driver::SysRW->new, # using sysread and syswrite Filter => POE::Filter::Line->new, # and parsing I/O as lines InputEvent => 'receive', # generating this event on input ErrorEvent => 'error', # generating this event on error ); shutdown($socket, 1); } #------------------------------------------------------------------------------ # This state is invoked by the ReadWrite wheel to process complete # chunks of input. sub client_receive { my ($heap, $line) = @_[HEAP, ARG0]; DEBUG && print "Client $heap->{'serial'} received: $line\n"; } #------------------------------------------------------------------------------ # This state is invoked by both the SocketFactory and the ReadWrite # wheels when an error occurs. sub client_error { my ($heap, $operation, $errnum, $errstr) = @_[HEAP, ARG0, ARG1, ARG2]; if (DEBUG) { if ($errnum) { print( "Client $heap->{'serial'} encountered ", "$operation error $errnum: $errstr\n" ); } else { print "Client $heap->{'serial'} the server closed the connection.\n"; } } # removing the wheel stops the session delete $heap->{'wheel'}; } #------------------------------------------------------------------------------ # Catch and log signals. Never handle them. sub client_signals { my ($heap, $signal_name) = @_[HEAP, ARG0]; DEBUG && print "Client $heap->{'serial'} caught SIG$signal_name\n"; # doesn't handle SIGINT, so it can stop return 0; } ############################################################################### # This is a client pool session. It ensures that at least five # clients are interacting with the server at any given time. # Actually, there are brief periods where only four clients are # connected. #------------------------------------------------------------------------------ # This is a regular Perl sub that helps create new client pools. It's # not an event handler. sub pool_create { # create the server POE::Session->create( inline_states => { _start => \&pool_start, _stop => \&pool_stop, signals => \&pool_signals, _child => \&pool_child, _parent => sub {}, }, ); } #------------------------------------------------------------------------------ # Accept POE's standard _start event. Initialize benchmark # accumulators, and start the first five clients. sub pool_start { my ($kernel, $heap) = @_[KERNEL, HEAP]; DEBUG && print "Pool starting.\n"; # watch for SIGINT $kernel->sig('INT', 'signals'); # keep track of children $heap->{'children'} = 0; $heap->{'client serial'} = 0; $heap->{'state'} = 'running'; # benchmark accumulators $heap->{'bench start'} = time(); $heap->{'bench count'} = 0; # Start five clients. NOTE: This would not work if clients used # IO::Socket to connect to the server, because IO::Socket's connect # blocks. It would wait for the server to accept a connection # before continuing, which would never happen since this loop is # holding up the event queue. The program can only get away with # this loop because SocketFactory connections do not block. for (my $i = 0; $i < MAX_SIMULTANEOUS_CLIENTS; $i++) { &client_create(++$heap->{'client serial'}); } } #------------------------------------------------------------------------------ # Accept POE's standard stop event. Also stop the server. sub pool_stop { my $kernel = $_[KERNEL]; # send SIGQUIT to the server $kernel->signal('server', 'QUIT'); DEBUG && print "Pool has stopped.\n"; } #------------------------------------------------------------------------------ # Catch and log signals, but never handle them. sub pool_signals { my ($heap, $signal_name) = @_[HEAP, ARG0]; DEBUG && print "Pool caught SIG$signal_name\n"; # doesn't handle SIGINT, so it can stop return 0; } #------------------------------------------------------------------------------ # Keep track of child sessions, starting new ones to replace old ones # that are being lost. If debugging, and a time limit has been # reached, stop creating new clients. my %english = ( create => 'created', lose => 'lost', gain => 'gained' ); sub pool_child { my ($heap, $direction, $child) = @_[HEAP, ARG0, ARG1]; # lost a client if ($direction eq 'lose') { $heap->{'children'}--; # create a new one if still running if ($heap->{'state'} eq 'running') { &client_create(++$heap->{'client serial'}); } } # gained a client; keep track of it else { $heap->{'children'}++; $heap->{'bench count'}++; } DEBUG && print( "Pool $english{$direction} a child session ", "(now has $heap->{'children'}).\n" ); # track clients/second for benchmark my $elapsed = time() - $heap->{'bench start'}; if ($elapsed >= 10) { print "bench: ", $heap->{'bench count'}, ' / ', $elapsed, ' = ', $heap->{'bench count'} / $elapsed, "\n"; $heap->{'bench count'} = 0; $heap->{'bench start'} = time(); # limit run to 60 seconds if debugging if (DEBUG && (time() - $^T >= 60.0)) { $heap->{'state'} = 'quitting'; } } } ############################################################################### # This is a single server session. It is spawned by the daytime # server to handle incoming connections. #------------------------------------------------------------------------------ # This is a regular Perl sub that helps create new sessions. It's not # an event handler. sub session_create { my ($handle, $peer_host, $peer_port) = @_; # create the session POE::Session->create( inline_states => { _start => \&session_start, _stop => \&session_stop, receive => \&session_receive, flushed => \&session_flushed, error => \&session_error, signals => \&session_signals, _child => sub {}, _parent => sub {}, }, # ARG0, ARG1, ARG2 args => [ $handle, $peer_host, $peer_port ] ); } #------------------------------------------------------------------------------ # Accept POE's standard _start event, and start transacting with the # client. sub session_start { my ($kernel, $heap, $handle, $peer_host, $peer_port) = @_[KERNEL, HEAP, ARG0, ARG1, ARG2]; # make the address printable $peer_host = inet_ntoa($peer_host); DEBUG && print "Session with $peer_host $peer_port is starting.\n"; # watch for SIGINT $kernel->sig('INT', 'signals'); # record the client info for later $heap->{'host'} = $peer_host; $heap->{'port'} = $peer_port; # start reading and writing $heap->{'wheel'} = POE::Wheel::ReadWrite->new( Handle => $handle, # on the client's socket Driver => POE::Driver::SysRW->new, # using sysread and syswrite Filter => POE::Filter::Line->new, # and parsing I/O as lines InputEvent => 'receive', # generating this event on input ErrorEvent => 'error', # generating this event on error FlushedEvent => 'flushed', # generating this event on flush ); # give the client the time of day $heap->{'wheel'}->put( "Hi, $peer_host $peer_port! The time is: " . gmtime() . " GMT" ); } #------------------------------------------------------------------------------ # Accept POE's standard _stop event. This normally would clean up the # session, but this program doesn't keep anything in the heap that # needs to be cleaned up. sub session_stop { my $heap = $_[HEAP]; DEBUG && print "Session with $heap->{'host'} $heap->{'port'} has stopped.\n"; } #------------------------------------------------------------------------------ # This state is invoked by the ReadWrite wheel whenever a complete # request has been received. sub session_receive { my ($heap, $line) = @_[HEAP, ARG0]; DEBUG && print "Received from $heap->{'host'} $heap->{'port'}: $line\n"; } #------------------------------------------------------------------------------ # This state is invoked when the ReadWrite wheel encounters an error. sub session_error { my ($heap, $operation, $errnum, $errstr) = @_[HEAP, ARG0, ARG1, ARG2]; DEBUG && print( "Session with $heap->{'host'} $heap->{'port'} ", "encountered $operation error $errnum: $errstr\n" ); delete $heap->{'wheel'}; } #------------------------------------------------------------------------------ # This state is invoked when the ReadWrite wheel's output buffer # becomes empty. For a daytime server session, a flushed buffer means # it's okay to close the connection. sub session_flushed { my $heap = $_[HEAP]; DEBUG && print "Output to $heap->{'host'} $heap->{'port'} has flushed.\n"; # removing the wheel stops the session delete $heap->{'wheel'}; } #------------------------------------------------------------------------------ # Catch and log signals, but never handle them. sub session_signals { my ($heap, $signal_name) = @_[HEAP, ARG0]; DEBUG && print( "Session with $heap->{'host'} $heap->{'port'} ", "has received a SIG$signal_name\n" ); # doesn't handle SIGINT, so it can stop return 0; } ############################################################################### # This is a generic daytime server. Its only purpose is to listen on # a socket, accept connections, and spawn daytime sessions to handle # the connections. #------------------------------------------------------------------------------ # This is a regular Perl sub that helps create new servers. It's not # an event handler. sub server_create { # create the server POE::Session->create( inline_states => { _start => \&server_start, _stop => \&server_stop, accept_success => \&server_accept, accept_error => \&server_error, signals => \&server_signals, _child => sub {}, _parent => sub {}, } ); } #------------------------------------------------------------------------------ # Accept POE's standard _start event. Create a non-blocking server. sub server_start { my ($kernel, $heap) = @_[KERNEL, HEAP]; DEBUG && print "Daytime server is starting.\n"; # set an alias so pool_stop can signal $kernel->alias_set('server'); # watch for SIGINT and SIGQUIT $kernel->sig('INT', 'signals'); $kernel->sig('QUIT', 'signals'); # create a socket factory $heap->{'wheel'} = POE::Wheel::SocketFactory->new( BindAddress => $server_addr, # bind the listener to this address BindPort => $server_port, # bind the listener to this port Reuse => 'yes', # and reuse the socket right away SuccessEvent => 'accept_success', # generate this event for connections FailureEvent => 'accept_error', # generate this event for errors ); } #------------------------------------------------------------------------------ # Accept POE's standard _stop event. This normally would clean up the # session, but this program doesn't keep anything in the heap that # needs to be cleaned up. sub server_stop { my $heap = $_[HEAP]; DEBUG && print "Daytime server has stopped.\n"; } #------------------------------------------------------------------------------ # This state is invoked by the SocketFactory when an error occurs. sub server_error { my ($operation, $errnum, $errstr) = @_[ARG0, ARG1, ARG2]; DEBUG && print "Daytime server encountered $operation error $errnum: $errstr\n"; } #------------------------------------------------------------------------------ # The SocketFactory invokes this state when a new client connection # has been accepted. The parameters include the client socket, # address and port. sub server_accept { my ($handle, $host, $port) = @_[ARG0, ARG1, ARG2]; # spawn a server session die "possible filehandle leak" if fileno($handle) > 63; &session_create($handle, $host, $port); } #------------------------------------------------------------------------------ # Catch and log signals, but never handle them. sub server_signals { my $signal_name = $_[ARG0]; DEBUG && print "Daytime server caught SIG$signal_name\n"; # doesn't handle SIGINT, so it can stop return 0; } ############################################################################### # Start the daytime server and a pool of clients to transact with it. &server_create(); &pool_create(); $poe_kernel->run(); exit; POE-1.370/examples/README.samples000644 001751 001751 00000000245 12143730314 017115 0ustar00bingosbingos000000 000000 Many of the samples that were once here are now available on the web. Please see http://poe.perl.org/?POE_Cookbook for the missing programs, plus a bunch of others. POE-1.370/examples/selects.perl000644 001751 001751 00000032472 12276766765 017161 0ustar00bingosbingos000000 000000 #!/usr/bin/perl -w # This is an early, basic test of POE's filehandle selecting # mechanism. It was written before POE::Wheel classes were conceived. # In fact, Wheels were invented after realizing that this program's # 'accept', 'read' and 'write' states would probably need to be # replicated for every TCP server that came after this one. # Anyway, this program creates two sessions. The first is an average # TCP chargen server, and the second is an average line-based client. # The client connects to the server, displays a few lines of chargen # output, and closes. The server remains active, and it can be # connected to by other clients, such as netcat or telnet. # This is a pre-wheel sockets test. It's one of the few that uses # IO::Socket. All the others (with exception of wheels.perl) have # been adapted to use POE::Wheel::SocketFactory. # If some aspects of using sessions are confusing, please see the # *session*.perl tests. They are commented in more detail. use strict; use lib '../lib'; use POE; use IO::Socket; use POSIX qw(EAGAIN); # the chargen server's listen port my $chargen_port = 32100; #============================================================================== # This is the session that will handle a client connection to the # server. An instance of it is spawned off from the server each time # a connection comes in. #------------------------------------------------------------------------------ # Start the chargen connection. sub connection_start { my ($kernel, $heap, $socket_handle, $peer_host, $peer_port) = @_[KERNEL, HEAP, ARG0, ARG1, ARG2]; # hello, world! print "Starting chargen connection with $peer_host:$peer_port ...\n"; # watch for SIGINT and SIGPIPE $kernel->sig('INT', 'signal'); $kernel->sig('PIPE', 'signal'); # remember things for later $heap->{'host'} = $peer_host; $heap->{'port'} = $peer_port; $heap->{'char'} = 32; # start watching the socket $kernel->select($socket_handle, 'read', 'write'); # return something interesting return gmtime(); } #------------------------------------------------------------------------------ # Stop the session. sub connection_stop { my $heap = $_[HEAP]; # goodbye, world! my $peer_host = $heap->{'host'}; my $peer_port = $heap->{'port'}; print "Stopped chargen connection with $peer_host:$peer_port\n"; } #------------------------------------------------------------------------------ # Events that arrive without a corresponding handler are rerouted to # _default. This _default handler just displays the nature of the # unknown event. It exists in this program mainly for debugging. sub connection_default { my ($state, $params) = @_[ARG0, ARG1]; print "The chargen connection has received a _default event.\n"; print "The original event was $state, with the following parameters:", join('; ', @$params), "\n"; # returns 0 in case it was a signal return 0; } #------------------------------------------------------------------------------ # The client is sending some information. Read and discard it. sub connection_read { my $handle = $_[ARG0]; 1 while (sysread($handle, my $buffer = '', 32000)); } #------------------------------------------------------------------------------ # The client connection can accept more information. Write a line of # generated characters to it. sub connection_write { my ($kernel, $heap, $handle) = @_[KERNEL, HEAP, ARG0]; # create a chargen line my $output_string = join('', map { chr } ($heap->{'char'} .. ($heap->{'char'}+71)) ) . "\x0D\x0A"; $output_string =~ tr[\x7F-\xDD][\x20-\x7E]; # increment the line's start character $heap->{'char'} = 32 if (++$heap->{'char'} > 126); # write the line (blocks!) my ($offset, $to_write) = (0, length($output_string)); while ($to_write) { my $sub_wrote = syswrite($handle, $output_string, $to_write, $offset); if ($sub_wrote) { $offset += $sub_wrote; $to_write -= $sub_wrote; } elsif ($!) { # close session on error print( "The chargen connection has encountered write error ", ($!+0), ": $!\n" ); $kernel->select($handle); last; } } } #------------------------------------------------------------------------------ # The session received a signal. Display the signal, and tell the # kernel that it can stop the session. sub connection_signal { my $signal_name = $_[ARG0]; print "The chargen connection received SIG$signal_name\n"; } #============================================================================== # This is a basic chargen server, as rendered in POE states. The # original example had the subs as inlined anonymous references, but # it's been pulled apart for clarity. #------------------------------------------------------------------------------ # Handle POE's standard _start event. This creates and begins # listening on a TCP server socket. sub server_start { my $kernel = $_[KERNEL]; # hello, world! print "The chargen server is starting on port $chargen_port ...\n"; # Watch for signals. Note: SIGPIPE is not considered to be a # terminal signal. The session will not be stopped if SIGPIPE is # unhandled. The signal handler is registered for SIGPIPE just so # we can see it occur. $kernel->sig('INT', 'signal'); $kernel->sig('PIPE', 'signal'); # create the listening socket my $listener = IO::Socket::INET->new( LocalPort => $chargen_port, Listen => 5, Proto => 'tcp', Reuse => 'yes', ); # move to 'accept' when read-okay if ($listener) { $kernel->select_read($listener, 'accept'); } else { print "The chargen server could not listen on $chargen_port: $!\n"; } } #------------------------------------------------------------------------------ # Stop the server when POE's standard _stop event arrives. Normally # this would garbage-collect the session's heap, but this simple # session doesn't need it. sub server_stop { print "The chargen server has stopped.\n"; } #------------------------------------------------------------------------------ # Take note when chargen connection come and go. my %english = ( gain => 'gained', lose => 'lost', create => 'created' ); sub server_child { my ($direction, $child, $return) = @_[ARG0, ARG1, ARG2]; print "The chargen server has $english{$direction} a child session.\n"; if ($direction eq 'create') { print "The child session's _start state returned: $return\n"; } } #------------------------------------------------------------------------------ # Events that arrive without a corresponding handler are rerouted to # _default. This _default handler just displays the nature of the # unknown event. It exists in this program mainly for debugging. sub server_default { my ($state, $params) = @_[ARG0, ARG1]; print "The chargen server has received a _default event.\n"; print "The original event was $state, with the following parameters:", join('; ', @$params), "\n"; # returns 0 in case it was a signal return 0; } #------------------------------------------------------------------------------ # This event handler is called when the listening socket becomes ready # for reading. It accepts the incoming connection, gathers some # information about it, and spawns a new session to handle I/O. sub server_accept { my ($kernel, $session, $handle) = @_[KERNEL, SESSION, ARG0]; print "The chargen server detected an incoming connection.\n"; # accept the handle my $connection = $handle->accept(); if ($connection) { # gather information about the socket my $peer_host = $connection->peerhost(); my $peer_port = $connection->peerport(); # create a session to handle I/O my $new = POE::Session->create( inline_states => { _start => \&connection_start, _stop => \&connection_stop, _default => \&connection_default, 'read' => \&connection_read, 'write' => \&connection_write, signal => \&connection_signal, }, # ARG0, ARG1 and ARG2 args => [ $connection, $peer_host, $peer_port ] ); } else { if ($! == EAGAIN) { print "Incoming chargen server connection not ready... try again!\n"; $kernel->yield('accept', $handle); } else { print "Incoming chargen server connection failed: $!\n"; } } } #------------------------------------------------------------------------------ # This sub is called whenever an "important" signal arrives. It just # displays details about the signals it receives. sub server_signal { my $signal_name = $_[ARG0]; print "The chargen server received SIG$signal_name\n"; return 0; } #============================================================================== # This is a basic line-based client, as rendered in POE states. The # original example had the subs as inlined anonymous references, but # it's been pulled apart for clarity. #------------------------------------------------------------------------------ # Start the client. It registers signal handlers and tries to # establish a connection. sub client_start { my ($kernel, $heap) = @_[KERNEL, HEAP]; print "The chargen client is connecting to port $chargen_port ...\n"; # register SIGINT and SIGPIPE handlers $kernel->sig('INT', 'signal'); $kernel->sig('PIPE', 'signal'); # so it knows when to stop $heap->{'lines read'} = 0; # try to make a connection my $socket = IO::Socket::INET->new( PeerHost => 'localhost', PeerPort => $chargen_port, Proto => 'tcp', Reuse => 'yes', ); # start reading if connected if ($socket) { print "The chargen client has connected to port $chargen_port.\n"; $kernel->select_read($socket, 'read'); } else { print "The chargen client could not connect to $chargen_port: $!\n"; } } #------------------------------------------------------------------------------ # Handle POE's standard _stop event. sub client_stop { print "\nThe chargen client has stopped.\n"; } #------------------------------------------------------------------------------ # Events that arrive without a corresponding handler are rerouted to # _default. This _default handler just displays the nature of the # unknown event. It exists in this program mainly for debugging. sub client_default { my ($state, $params) = @_[ARG0, ARG1]; print "The chargen client has received a _default event.\n"; print "The original event was $state, with the following parameters:", join('; ', @$params), "\n"; # returns 0 in case it was a signal return 0; } #------------------------------------------------------------------------------ # This handler is called when the client can read. It displays # whatever was read, exiting when either a few lines have displayed or # an error has occurred. sub client_read { my ($kernel, $heap, $handle) = @_[KERNEL, HEAP, ARG0]; # read a chunk of input my $read_count = sysread($handle, my $buffer = '', 512); # display it if ($read_count) { print $buffer; # count lines; exit if 5 or more $heap->{'lines read'} += ($buffer =~ s/(\x0D\x0A)/$1/g); if ($heap->{'lines read'} > 5) { # The read select is the only part of this session that # generates events. When it is removed, the session runs out of # things to do and stops. $kernel->select($handle); } } # stop if there was trouble reading else { $kernel->select($handle); } } #------------------------------------------------------------------------------ # This sub is called whenever an "important" signal arrives. It just # displays details about the signals it receives. sub client_signal { my $signal_name = $_[ARG0]; print "The chargen client received SIG$signal_name\n"; return 0; } #============================================================================== # Start a server and a client, and run indefinitely. POE::Session->create( inline_states => { _start => \&server_start, _stop => \&server_stop, _default => \&server_default, _child => \&server_child, 'accept' => \&server_accept, signal => \&server_signal, }, ); POE::Session->create( inline_states => { _start => \&client_start, _stop => \&client_stop, _default => \&client_default, 'read' => \&client_read, signal => \&client_signal, }, ); POE::Kernel->run(); exit; POE-1.370/examples/watermarks.perl000644 001751 001751 00000013743 12276766765 017677 0ustar00bingosbingos000000 000000 #!/usr/bin/perl -w # This program tests the high and low watermarks. It merges the # wheels from wheels.perl and the chargen service from selects.perl to # create a wheel-based chargen service. use strict; use lib '../lib'; use POE qw(Wheel::SocketFactory Wheel::ReadWrite Driver::SysRW Filter::Line); my $chargen_port = 32100; #============================================================================== # This is a simple TCP server. It answers connections and passes them # to new chargen service sessions. package Chargen::Server; use POE::Session; # Create a new chargen server. This doesn't create a real object; it # just spawns a new session. OO purists will hate me for this. sub new { POE::Session->create ( inline_states => { _start => \&poe_start, accepted => \&poe_accepted, error => \&poe_error, } ); undef; } # The Session has been set up within POE::Kernel, so it's safe to # begin working. Create a socket factory to listen for new # connections. sub poe_start { $_[HEAP]->{listener} = POE::Wheel::SocketFactory->new ( SuccessEvent => 'accepted', FailureEvent => 'error', BindPort => $chargen_port, Reuse => 'yes', ); } # Start a session to handle successfully connected clients. sub poe_accepted { Chargen::Connection->new($_[ARG0]); } # Upon error, log the error and stop the server. Client sessions may # still be running, and the process will continue until they # gracefully exit. sub poe_error { warn "Chargen::Server encountered $_[ARG0] error $_[ARG1]: $_[ARG2]\n"; delete $_[HEAP]->{listener}; } #============================================================================== # This is a simple chargen service. package Chargen::Connection; use POE::Session; # Create a new chargen session around a successfully accepted socket. sub new { my ($package, $socket) = @_; POE::Session->create ( inline_states => { _start => \&poe_start, wheel_got_flush => \&poe_got_flush, wheel_got_input => \&poe_got_input, wheel_got_error => \&poe_got_error, wheel_throttle => \&poe_throttle, wheel_resume => \&poe_resume, write_chunk => \&poe_write_chunk, }, args => [ $socket ], ); undef; } # The session was set up within POE::Kernel, so it's safe to begin # working. Wrap a ReadWrite wheel around the socket, set up some # persistent variables, and begin writing chunks. sub poe_start { $_[HEAP]->{wheel} = POE::Wheel::ReadWrite->new ( Handle => $_[ARG0], Driver => POE::Driver::SysRW->new(), Filter => POE::Filter::Line->new(), InputEvent => 'wheel_got_input', ErrorEvent => 'wheel_got_error', HighMark => 256, LowMark => 128, HighEvent => 'wheel_throttle', LowEvent => 'wheel_resume', ); $_[HEAP]->{okay_to_send} = 1; $_[HEAP]->{start_character} = 32; $_[KERNEL]->yield('write_chunk'); } # The client sent us input. Rather than leaving it on the socket, # we've read it to ignore it. sub poe_got_input { warn "Chargen session ", $_[SESSION]->ID, " is ignoring some input.\n"; } # An error occurred. Log it and stop this session. If the parent # hasn't stopped, then it will continue running. sub poe_got_error { warn( "Chargen session ", $_[SESSION]->ID, " encountered ", $_[ARG0], " error $_[ARG1]: $_[ARG2]\n" ); $_[HEAP]->{okay_to_send} = 0; delete $_[HEAP]->{wheel}; } # Write a chunk of data to the client socket. sub poe_write_chunk { # Sometimes a write-chunk event comes in that ought not. This race # occurs because water-mark events are called synchronously, while # write-chunk events are posted asynchronously. So it may not be # okay to write a chunk when we get a write-chunk event. return unless $_[HEAP]->{okay_to_send}; # Enqueue chunks until ReadWrite->put() signals that its driver's # buffer has reached (or exceeded) its high-water mark. while (1) { # Create a chargen line. Build a 72-column line of consecutive # characters, starting with whatever character code we have # stored. Wrap characters beyond "~" around to " ". my $chargen_line = join( '', map { chr } ($_[HEAP]->{start_character} .. ($_[HEAP]->{start_character}+71)) ); $chargen_line =~ tr[\x7F-\xDD][\x20-\x7E]; # Increment the start character, wrapping \x7F to \x20. $_[HEAP]->{start_character} = 32 if (++$_[HEAP]->{start_character} > 126); # Enqueue the line for output. Stop enqueuing lines if the # buffer's high water mark is reached. last if $_[HEAP]->{wheel}->put($chargen_line); } warn "Chargen session ", $_[SESSION]->ID, " writes are paused.\n"; } # Be impressive. Log that the session has throttled, and set a flag # so spurious write-chunk events are ignored. sub poe_throttle { warn "Chargen session ", $_[SESSION]->ID, " is throttled.\n"; $_[HEAP]->{okay_to_send} = 0; } # Be impressive, part two. Log that the session has resumed sending, # and clear the stop-writing flag. Only bother doing this if there's # still a handle; that way it doesn't keep looping around after an # error or something. sub poe_resume { if (exists $_[HEAP]->{wheel}) { warn "Chargen session ", $_[SESSION]->ID, " is resuming.\n"; $_[HEAP]->{okay_to_send} = 1; $_[KERNEL]->yield('write_chunk'); } } #============================================================================== # Main loop. Create the server, and run it until something stops it. package main; print( "*** If all goes well, a watermarked (self-throttling) chargen\n", "*** service will be listening on localhost port $chargen_port.\n", "*** Watch it perform flow control by connecting to it over a slow\n", "*** connection or with a client you can pause. The server will\n", "*** throttle itself when its output buffer becomes too large, and\n", "*** it will resume output when the client receives enough data.\n", ); Chargen::Server->new; $poe_kernel->run(); exit; POE-1.370/examples/wheels2.perl000644 001751 001751 00000011472 12143730314 017033 0ustar00bingosbingos000000 000000 #!/usr/bin/perl -w # A simple socket client that uses a two-handle wheel to pipe between # a socket and the console. It's hardcoded to talk with wheels.perl's # rot13 server on localhost port 32100. use strict; use lib '../lib'; use POSIX; BEGIN { die "This example uses the console, but $^O doesn't support select() on console handles, sorry." if $^O eq "MSWin32"; } use POE qw(Wheel::SocketFactory Wheel::ReadWrite Driver::SysRW Filter::Stream); my $rot13_port = 32100; #============================================================================== # A client socket session that pipes between a connected socket and # the console. It has two phases of operation: Connect phase, and # Interact phase. #------------------------------------------------------------------------------ # Start the session by trying to connect to a server. Create a # SocketFactory, then sit back until something occurs. sub session_start { my ($kernel, $heap, $connected_socket) = @_[KERNEL, HEAP, ARG0]; print "Connecting...\n"; $heap->{connector} = POE::Wheel::SocketFactory->new( RemoteAddress => '127.0.0.1', RemotePort => $rot13_port, SuccessEvent => 'connect_success', FailureEvent => 'connect_failure', ); } #------------------------------------------------------------------------------ # The connection succeeded. Discard the spent SocketFactory, and # start two ReadWrite wheels to pipe data back and forth. NOTE: This # doesn't do terminal characteristic games, so I/O may be choppy or # otherwise icky. sub session_connect_success { my ($heap, $kernel, $connected_socket) = @_[HEAP, KERNEL, ARG0]; delete $heap->{connector}; $heap->{console_wheel} = POE::Wheel::ReadWrite->new( InputHandle => \*STDIN, OutputHandle => \*STDOUT, Driver => POE::Driver::SysRW->new, Filter => POE::Filter::Stream->new, InputEvent => 'console_input', ErrorEvent => 'console_error', ); $heap->{socket_wheel} = POE::Wheel::ReadWrite->new( Handle => $connected_socket, Driver => POE::Driver::SysRW->new, Filter => POE::Filter::Stream->new, InputEvent => 'socket_input', ErrorEvent => 'socket_error', ); $heap->{console_wheel}->put("Begun terminal session."); } #------------------------------------------------------------------------------ # The connection failed. Close down everything so that POE will reap # the session and exit. sub session_connect_failure { my ($heap, $operation, $errnum, $errstr) = @_[HEAP, ARG0, ARG1, ARG2]; if ($errnum) { print "!!! Connecting: $operation error $errnum: $errstr\n"; } delete $heap->{connector}; delete $heap->{console_wheel}; delete $heap->{socket_wheel}; } #------------------------------------------------------------------------------ # The session has stopped. Delete the wheels once again, just for # redundancy's sake. sub session_stop { my $heap = $_[HEAP]; delete $heap->{connector}; delete $heap->{console_wheel}; delete $heap->{socket_wheel}; } #------------------------------------------------------------------------------ # Console input has arrived. Send it to the socket. sub session_console_input { $_[HEAP]->{socket_wheel}->put($_[ARG0]); } #------------------------------------------------------------------------------ # There has been an error on one of the console filehandles. Close # down everything so that POE will reap the session and exit. sub session_console_error { my ($heap, $operation, $errnum, $errstr) = @_[HEAP, ARG0, ARG1, ARG2]; if ($errnum) { print "!!! Console: $operation error $errnum: $errstr\n"; } delete $heap->{console_wheel}; delete $heap->{socket_wheel}; } #------------------------------------------------------------------------------ # Socket input has arrived. Send it to the console. sub session_socket_input { $_[HEAP]->{console_wheel}->put($_[ARG0]); } #------------------------------------------------------------------------------ # A socket error has occurred. Close down everything so that POE will # reap the session and exit. sub session_socket_error { my ($heap, $operation, $errnum, $errstr) = @_[HEAP, ARG0, ARG1, ARG2]; if ($errnum) { print "!!! Socket: $operation error $errnum: $errstr\n"; } delete $heap->{console_wheel}; delete $heap->{socket_wheel}; } #============================================================================== # Start the Session, which will fire off the _start event and begin # the connection. POE::Session->create( inline_states => { _start => \&session_start, _stop => \&session_stop, connect_success => \&session_connect_success, connect_failure => \&session_connect_failure, console_input => \&session_console_input, console_error => \&session_console_error, socket_input => \&session_socket_input, socket_error => \&session_socket_error, }, ); $poe_kernel->run(); exit; POE-1.370/examples/tcp_watermarks.perl000644 001751 001751 00000011602 12276766765 020535 0ustar00bingosbingos000000 000000 #!/usr/bin/perl -w # This program tests the high and low watermarks. It merges the # wheels from wheels.perl and the chargen service from selects.perl to # create a wheel-based chargen service. It differs from # watermarks.perl in that it uses a TCP server component. use strict; use lib '../lib'; use POE qw(Component::Server::TCP Wheel::ReadWrite Driver::SysRW Filter::Line); my $chargen_port = 32100; #============================================================================== # This is a simple chargen service. package Chargen::Connection; use POE::Session; # Create a new chargen session around a successfully accepted socket. sub new { my ($package, $socket) = @_; POE::Session->create ( inline_states => { _start => \&poe_start, wheel_got_flush => \&poe_got_flush, wheel_got_input => \&poe_got_input, wheel_got_error => \&poe_got_error, wheel_throttle => \&poe_throttle, wheel_resume => \&poe_resume, write_chunk => \&poe_write_chunk, }, args => [ $socket ], ); undef; } # The session was set up within POE::Kernel, so it's safe to begin # working. Wrap a ReadWrite wheel around the socket, set up some # persistent variables, and begin writing chunks. sub poe_start { $_[HEAP]->{wheel} = POE::Wheel::ReadWrite->new ( Handle => $_[ARG0], Driver => POE::Driver::SysRW->new(), Filter => POE::Filter::Line->new(), InputEvent => 'wheel_got_input', ErrorEvent => 'wheel_got_error', HighMark => 1024, LowMark => 128, HighEvent => 'wheel_throttle', LowEvent => 'wheel_resume', ); $_[HEAP]->{okay_to_send} = 1; $_[HEAP]->{start_character} = 32; $_[KERNEL]->yield('write_chunk'); } # The client sent us input. Rather than leaving it on the socket, # we've read it to ignore it. sub poe_got_input { warn "Chargen session ", $_[SESSION]->ID, " is ignoring some input.\n"; } # An error occurred. Log it and stop this session. If the parent # hasn't stopped, then it will continue running. sub poe_got_error { warn( "Chargen session ", $_[SESSION]->ID, " encountered ", $_[ARG0], " error $_[ARG1]: $_[ARG2]\n" ); $_[HEAP]->{okay_to_send} = 0; delete $_[HEAP]->{wheel}; } # Write a chunk of data to the client socket. sub poe_write_chunk { # Sometimes a write-chunk event comes in that ought not. This race # occurs because water-mark events are called synchronously, while # write-chunk events are posted asynchronously. So it may not be # okay to write a chunk when we get a write-chunk event. return unless $_[HEAP]->{okay_to_send}; # Enqueue chunks until ReadWrite->put() signals that its driver's # buffer has reached (or exceeded) its high-water mark. while (1) { # Create a chargen line. Build a 72-column line of consecutive # characters, starting with whatever character code we have # stored. Wrap characters beyond "~" around to " ". my $chargen_line = join( '', map { chr } ($_[HEAP]->{start_character} .. ($_[HEAP]->{start_character}+71)) ); $chargen_line =~ tr[\x7F-\xDD][\x20-\x7E]; # Increment the start character, wrapping \x7F to \x20. $_[HEAP]->{start_character} = 32 if ++$_[HEAP]->{start_character} > 126; # Enqueue the line for output. Stop enqueuing lines if the # buffer's high water mark is reached. last if $_[HEAP]->{wheel}->put($chargen_line); } warn "Chargen session ", $_[SESSION]->ID, " writes are paused.\n"; } # Be impressive. Log that the session has throttled, and set a flag # so spurious write-chunk events are ignored. sub poe_throttle { warn "Chargen session ", $_[SESSION]->ID, " is throttled.\n"; $_[HEAP]->{okay_to_send} = 0; } # Be impressive, part two. Log that the session has resumed sending, # and clear the stop-writing flag. Only bother doing this if there's # still a handle; that way it doesn't keep looping around after an # error or something. sub poe_resume { if (exists $_[HEAP]->{wheel}) { warn "Chargen session ", $_[SESSION]->ID, " is resuming.\n"; $_[HEAP]->{okay_to_send} = 1; $_[KERNEL]->yield('write_chunk'); } } #============================================================================== # Main loop. Create the server, and run it until something stops it. package main; print( "*** If all goes well, a watermarked (self-throttling) chargen\n", "*** service will be listening on localhost port $chargen_port.\n", "*** Watch it perform flow control by connecting to it over a slow\n", "*** connection or with a client you can pause. The server will\n", "*** throttle itself when its output buffer becomes too large, and\n", "*** it will resume output when the client receives enough data.\n", ); POE::Component::Server::TCP->new ( Port => $chargen_port, Acceptor => sub { Chargen::Connection->new($_[ARG0]); }, ); $poe_kernel->run(); exit; POE-1.370/examples/packagesessions.perl000644 001751 001751 00000007737 12143730314 020655 0ustar00bingosbingos000000 000000 #!/usr/bin/perl -w -I.. # This is a simple test of "package sessions". These are similar to # object sessions, but they work with packages instead of objects. It # is also a simpler test than sessions.perl. use strict; use lib '../lib'; use POE; #============================================================================== # Counter is a package composed of event handler functions. It is # never instantiated as an object here. package Counter; use strict; use POE::Session; # stupid scope trick, part 1 of 3 $Counter::name = ''; #------------------------------------------------------------------------------ # This is a normal subroutine, not an object method. It sets up the # session's variables and sets the session in motion. sub _start { my ($kernel, $session, $heap) = @_[KERNEL, SESSION, HEAP]; # register a signal handler $kernel->sig('INT', 'sigint'); # initialize the counter $heap->{'counter'} = 0; # stupid scope trick, part 2 of 3 $heap->{'name'} = $Counter::name; # hello, world! print "Session $heap->{'name'} started.\n"; # start things moving $kernel->post($session, 'increment'); } #------------------------------------------------------------------------------ # This is a normal subroutine, not an object method. It cleans up # after receiving POE's standard _stop event. sub _stop { my $heap = $_[HEAP]; print "Session $heap->{'name'} stopped after $heap->{'counter'} loops.\n"; } #------------------------------------------------------------------------------ # This is a normal subroutine, and not an object method. It will be # registered as a SIGINT handler so that the session can acknowledge # the signal. sub sigint { my ($heap, $from, $signal_name) = @_[HEAP, SENDER, ARG0]; print "$heap->{'name'} caught SIG$signal_name from $from\n"; # did not handle the signal return 0; } #------------------------------------------------------------------------------ # This is a normal subroutine, and not an object method. It does most # of the counting work. It loops by posting events back to itself. # The session exits when there is nothing left to do; this event # handler causes that condition when it stops posting events. sub increment { my ($package, $kernel, $session, $heap) = @_[OBJECT, KERNEL, SESSION, HEAP]; $heap->{'counter'}++; if ($heap->{counter} % 2) { $kernel->state('runtime_state', $package); } else { $kernel->state('runtime_state'); } print "Session $heap->{'name'}, iteration $heap->{'counter'}.\n"; if ($heap->{'counter'} < 5) { $kernel->post($session, 'increment'); $kernel->yield('runtime_state', $heap->{counter}); } else { # no more events. since there is nothing left to do, the session exits. } } #------------------------------------------------------------------------------ # This state is added on every even count. It's removed on every odd # one. Every count posts an event here. sub runtime_state { my ($session, $heap, $iteration) = @_[SESSION, HEAP, ARG0]; print( 'Session ', $heap->{name}, ' received a runtime_state event during iteration ', $iteration, "\n" ); } #============================================================================== # Create ten Counter sessions, all sharing the subs in package # Counter. In a way, POE's sessions provide a simple form of object # instantiation. package main; foreach my $name (qw(one two three four five six seven eight nine ten)) { # stupid scope trick, part 3 of 3 $Counter::name = $name; # create the session POE::Session->create( package_states => [ Counter => [ qw(_start _stop increment sigint) ] ] ); } $poe_kernel->run(); exit; POE-1.370/mylib/svn-log.perl000644 001751 001751 00000017433 12276766765 016402 0ustar00bingosbingos000000 000000 #!/usr/bin/env perl # This program is Copyright 2005-2013 by Rocco Caputo. All rights are # reserved. This program is free software. It may be modified, used, # and redistributed under the same terms as Perl itself. # Generate a nice looking change log from the subversion logs for a # Perl project. The log is also easy for machines to parse. use warnings; use strict; use Getopt::Long; use Text::Wrap qw(wrap fill $columns $huge); use POSIX qw(strftime); use XML::Parser; use XML::LibXML; use constant DEBUG => 1; my %month = qw( Jan 01 Feb 02 Mar 03 Apr 04 May 05 Jun 06 Jul 07 Aug 08 Sep 09 Oct 10 Nov 11 Dec 12 ); $Text::Wrap::huge = "wrap"; $Text::Wrap::columns = 74; my $days_back = 365; # Go back a year by default. my $send_help = 0; # Display help and exit. my $svn_repo; # Where to log from. my $tag_pattern = "^v\\d+_"; use constant LOG_REV => 0; use constant LOG_DATE => 1; use constant LOG_WHO => 2; use constant LOG_MESSAGE => 3; use constant LOG_PATHS => 4; use constant PATH_PATH => 0; use constant PATH_ACTION => 1; use constant PATH_CPF_PATH => 2; use constant PATH_CPF_REV => 3; use constant TAG_REV => 0; use constant TAG_TAG => 1; use constant TAG_LOG => 2; use constant MAX_TIMESTAMP => "9999-99-99 99:99:99.999999Z"; GetOptions( "age=s" => \$days_back, "repo=s" => \$svn_repo, "help" => \$send_help, "tags=s" => \$tag_pattern, ) or exit; # Find the trunk for the current repository if one isn't specified. unless (defined $svn_repo) { $svn_repo = `svn info . | grep '^URL: '`; if (length $svn_repo) { chomp $svn_repo; $svn_repo =~ s{^URL\:\s+(.+?)/trunk/?.*$}{$1}; } else { $send_help = 1; } } die( "$0 usage:\n", " --repo URL where to find the repository\n", " [--age DAYS] limit report to DAYS in the past (default: 365)\n", " [--tags REGEXP] report on tags matching REGEXP (default: ^v\\d+_)\n", "\n", "REPOSITORY must have a trunk subdirectory and a tags directory where\n", "release tags are kept.\n", ) if $send_help; my $earliest_date = strftime( "%FT%T.000000Z", gmtime(time() - $days_back * 86400) ); DEBUG and warn "earliest date = $earliest_date\n"; ### 1. Gather a list of tags for the repository, their revisions and ### dates. my %tag; my $parser = XML::LibXML->new(); my $doc = $parser->parse_string(scalar `svn --xml list $svn_repo/tags`); sub get_value_of_element { my $element = shift; return "" unless defined $element; my $child = $element->getFirstChild(); return "" unless defined $child; my $value = $child->getData(); return "" unless defined $value; $value =~ s/\s+/ /g; $value =~ s/^\s//; $value =~ s/\s$//; return $value; } # # docs-wiki-start # # rcaputo # 2006-03-20T02:54:27.572888Z # # foreach my $entry ($doc->getElementsByTagName("entry")) { next unless $entry->getAttribute("kind") eq "dir"; my $tag = get_value_of_element(($entry->getChildrenByTagName("name"))[0]); my ($rev, $author, $date); foreach my $commit ($entry->getElementsByTagName("commit")) { $rev = $commit->getAttribute("revision"); $author = get_value_of_element( ($commit->getChildrenByTagName("author"))[0] ); $date = get_value_of_element( ($commit->getChildrenByTagName("date"))[0] ); } next unless $tag =~ /$tag_pattern/o; DEBUG and warn "rev($rev) date($date) tag($tag)\n"; $tag{$date} = [ $rev, # TAG_REV $tag, # TAG_TAG [ ], # TAG_LOG ]; } # Fictitious "HEAD" tag for revisions that came after the last tag. $tag{+MAX_TIMESTAMP} = [ "HEAD", # TAG_REV "(untagged)", # TAG_TAG undef, # TAG_LOG ]; ### 2. Gather the log for the current directory. Store log entries ### under their proper tags. my @tag_dates = sort keys %tag; while (my $date = pop(@tag_dates)) { # We're done if this date's before our earliest date. if ($date lt $earliest_date) { delete $tag{$date}; next; } my $tag = $tag{$date}[TAG_TAG]; DEBUG and warn "Gathering information for tag $tag...\n"; my $this_rev = $tag{$date}[TAG_REV]; my $prev_rev; if (@tag_dates) { $prev_rev = $tag{$tag_dates[-1]}[TAG_REV]; } else { $prev_rev = 0; } DEBUG and warn "$this_rev:$prev_rev"; my @log = gather_log(".", "-r", "$this_rev:$prev_rev"); $tag{$date}[TAG_LOG] = \@log; } ### 3. PROFIT! No, wait... generate the nice log file. foreach my $timestamp (sort { $b cmp $a } keys %tag) { last if $timestamp lt $earliest_date; my $tag_rec = $tag{$timestamp}; # Skip this tag if there are no log entries. next unless @{$tag_rec->[TAG_LOG]}; my $tag_line = "$timestamp $tag_rec->[TAG_TAG]"; my $tag_bar = "=" x length($tag_line); print $tag_bar, "\n", $tag_line, "\n", $tag_bar, "\n\n"; foreach my $log_rec (@{$tag_rec->[TAG_LOG]}) { my @paths = @{$log_rec->[LOG_PATHS]}; if (@paths > 1) { @paths = grep { $_->[PATH_PATH] ne "/trunk" or $_->[PATH_ACTION] ne "M" } @paths; } my $time_line = wrap( " ", " ", join( "; ", "$log_rec->[LOG_DATE] (r$log_rec->[LOG_REV]) by $log_rec->[LOG_WHO]", map { "$_->[PATH_PATH] $_->[PATH_ACTION]" } @paths ) ); if ($time_line =~ /\n/) { $time_line = wrap( " ", " ", "$log_rec->[LOG_DATE] (r$log_rec->[LOG_REV]) by $log_rec->[LOG_WHO]\n" ) . wrap( " ", " ", join( "; ", map { "$_->[PATH_PATH] $_->[PATH_ACTION]" } @paths ) ); } print $time_line, "\n\n"; # Blank lines should have the indent level of whitespace. This # makes it easier for other utilities to parse them. my @paragraphs = split /\n\s*\n/, $log_rec->[LOG_MESSAGE]; foreach my $paragraph (@paragraphs) { # Trim off identical leading space from every line. my ($whitespace) = $paragraph =~ /^(\s*)/; if (length $whitespace) { $paragraph =~ s/^$whitespace//mg; } # Re-flow the paragraph if it isn't indented from the norm. # This should preserve indented quoted text, wiki-style. unless ($paragraph =~ /^\s/) { $paragraph = fill(" ", " ", $paragraph); } } print join("\n \n", @paragraphs), "\n\n"; } } print( "==============\n", "End of Excerpt\n", "==============\n", ); ### Z. Helper functions. sub gather_log { my ($url, @flags) = @_; my (@log, @stack); my $parser = XML::Parser->new( Handlers => { Start => sub { my ($self, $tag, %att) = @_; push @stack, [ $tag, \%att ]; if ($tag eq "logentry") { push @log, [ ]; $log[-1][LOG_WHO] = "(nobody)"; } }, Char => sub { my ($self, $text) = @_; $stack[-1][1]{0} .= $text; }, End => sub { my ($self, $tag) = @_; die "close $tag w/out open" unless @stack; my ($pop_tag, $att) = @{pop @stack}; die "$tag ne $pop_tag" if $tag ne $pop_tag; if ($tag eq "date") { my $timestamp = $att->{0}; my ($date, $time) = split /[T.]/, $timestamp; $log[-1][LOG_DATE] = "$date $time"; return; } if ($tag eq "logentry") { $log[-1][LOG_REV] = $att->{revision}; return; } if ($tag eq "msg") { $log[-1][LOG_MESSAGE] = $att->{0}; return; } if ($tag eq "author") { $log[-1][LOG_WHO] = $att->{0}; return; } if ($tag eq "path") { my $path = $att->{0}; $path =~ s{^/trunk/}{}; push( @{$log[-1][LOG_PATHS]}, [ $path, # PATH_PATH $att->{action}, # PATH_ACTION ] ); $log[-1][LOG_PATHS][-1][PATH_CPF_PATH] = $att->{"copyfrom-path"} if ( exists $att->{"copyfrom-path"} ); $log[-1][LOG_PATHS][-1][PATH_CPF_REV] = $att->{"copyfrom-rev"} if ( exists $att->{"copyfrom-rev"} ); return; } } } ); my $cmd = "svn -v --xml @flags log $url"; DEBUG and warn "Command: $cmd\n"; open(LOG, "$cmd|") or die $!; $parser->parse(*LOG); close LOG; return @log; } POE-1.370/mylib/events_per_second.pl000644 001751 001751 00000003626 12143730314 020140 0ustar00bingosbingos000000 000000 #!/usr/bin/perl use strict; use vars qw($NUM_OF_EVENTS $USE_EVENT $USE_IO_POLL); use Time::HiRes qw(gettimeofday tv_interval); sub die_usage { my $usage = "\n"; if(my $msg = shift) { $usage .= "ERROR: $msg\n\n"; } $usage .= < < --use-event > < --use-io-poll > Options: --help : this help text --events=NUM : the number of events to run. defaults to 10000 --use-event : use Event.pm's internal event loop --use-io-poll : use IO::Poll.pm's internal event loop if --use-event or --use-io-poll are not chosen, POE's native event loop will be used. EOU my_die($usage); } sub my_die ($) { print STDERR $_[0]."\n"; exit 1; } sub late_use ($) { my $module = shift; eval "use $module;"; my_die($@) if ($@); } BEGIN { use Getopt::Long; $USE_EVENT = 0; $USE_IO_POLL = 0; my $help = 0; $NUM_OF_EVENTS = 10000; GetOptions( 'events=i' => \$NUM_OF_EVENTS, 'use-event+' => \$USE_EVENT, 'use-io-poll+' => \$USE_IO_POLL, 'help+' => \$help, ); die_usage() if $help; die_usage('Both use-event and use-io-poll are selected. Only one loop type may be chosen.') if($USE_EVENT + $USE_IO_POLL > 1); if($USE_EVENT) { late_use('Event'); } elsif ($USE_IO_POLL) { late_use('IO::Poll'); } late_use('POE'); } my($tr_start, $tr_stop); POE::Session->create( inline_states => { _start => sub { $tr_start = [gettimeofday]; $_[KERNEL]->yield('iterate', 0) }, _stop => sub { $tr_stop = [gettimeofday] }, iterate => sub { $_[KERNEL]->yield('iterate', ++$_[ARG0]) unless $_[ARG0] > $NUM_OF_EVENTS; } } ); $POE::Kernel::poe_kernel->run(); my $elapsed = tv_interval($tr_start, $tr_stop); my $event_avg = int($NUM_OF_EVENTS/$elapsed); print "Events per second: $event_avg\n"; POE-1.370/mylib/Devel/000755 001751 001751 00000000000 14216613074 015134 5ustar00bingosbingos000000 000000 POE-1.370/mylib/MyOtherFreezer.pm000644 001751 001751 00000001466 12143730314 017346 0ustar00bingosbingos000000 000000 # A sample external freezer for POE::Filter::Reference testing. package MyOtherFreezer; use strict; sub new { my $type = shift; return bless [ ], $type; } sub freeze { my $thing = shift; $thing = shift if ref($thing) eq 'MyOtherFreezer'; if (ref($thing) eq 'SCALAR') { return reverse(join "\0", ref($thing), $$thing); } elsif (ref($thing) eq 'Package') { return reverse(join "\0", ref($thing), @$thing); } die "can't freeze things of type ", ref($thing); } sub thaw { my $thing = shift; $thing = shift if ref($thing) eq 'MyOtherFreezer'; my ($type, @stuff) = split /\0/, reverse($thing); if ($type eq 'SCALAR') { my $scalar = $stuff[0]; return \$scalar; } elsif ($type eq 'Package') { return bless \@stuff, $type; } die "can't thaw things of type $type"; } 1; POE-1.370/mylib/coverage.perl000644 001751 001751 00000005502 12143730314 016550 0ustar00bingosbingos000000 000000 #!/usr/bin/perl -w # rocco // vim: ts=2 sw=2 expandtab # Runs "make test" with Devel::Cover to check POE's test coverage. # Generates a quite fine HTML report in the db_cover directory. use strict; use Cwd; use Getopt::Long; use Config; use File::Spec; # HARNESS_PERL_SWITCHES=$(perl mylib/coverage.perl --coverflags) prove -br t/10_units/ my ($opt_coverflags, $opt_prove, $opt_noclean); my ($cover, $prove, $make) = ( File::Spec->catfile($Config{bin}, "/cover"), File::Spec->catfile($Config{bin}, "prove"), $Config{make} ); GetOptions( 'coverflags' => \$opt_coverflags, 'prove' => sub { $opt_prove = 1; die "!FINISH" }, 'noclean' => \$opt_noclean, 'path-cover=s' => \$cover, 'path-prove=s' => \$prove, 'path-make=s' => \$make, ) or die "$0: usage\n"; my $output_dir = cwd() . "/cover_db"; my $hps = $ENV{HARNESS_PERL_SWITCHES} || ""; $hps =~ s/~/$ENV{HOME}/g; my @includes = ("mylib", $hps =~ /-I\s*(\S+)/g); $hps =~ s/(?<=-I)\s+//g; my $ignores = join( ",", map("+inc,$_", @includes), "+ignore,^t/", "+ignore,POE/Test/Loop", ); warn "*** Ignores: $ignores"; my $cover_options = "-MDevel::Cover"; $cover_options .= "=$ignores" if $ignores; if ($opt_coverflags) { print $cover_options, "\n"; exit 0; } # preparation/cleaning steps unless ($opt_noclean) { system( $make, "distclean" ); system( $^X, "Makefile.PL", "--default" ) and exit($? >> 8); system( $make ) and exit($? >> 8); if (-e $output_dir) { system( $^X, $cover, "-delete", $output_dir ) and exit($? >> 8); } } # run the test suite in the coverage environment { my $harness_switches = "$hps $cover_options"; $harness_switches =~ s/^\s+//; $harness_switches =~ s/\s+$//; warn "*** HARNESS_PERL_SWITCHES = $harness_switches"; local $ENV{HARNESS_PERL_SWITCHES} = $harness_switches; if ($opt_prove) { warn "*** proving: $prove @ARGV"; system( $prove, @ARGV ) and exit($? >> 8); } elsif (@ARGV) { # it might be more useful to punt to prove(1), but prove isn't always # available, maybe a --prove flag foreach my $test (@ARGV) { warn "*** running: $^X $harness_switches $test"; system( $^X, $harness_switches, $test ) and exit($? >> 8); } } else { system( $make, "test" ) and exit($? >> 8); } } # coverage report system( $^X, $cover, $output_dir ) and exit($? >> 8); warn "*** used ".((times)[2] + (times)[3])." seconds of CPU"; exit; __END__ =head1 NAME coverage.perl -- A command-line tool for producing coverage reports of POE =head1 SYNOPSIS coverage.perl [options] [tests] Options: --coverflags Print out the -MDevel::Cover option that would have been used, then exit. --noclean Do not clean and rebuild source tree or cover_db --prove Run the prove utility with the rest of the command line POE-1.370/mylib/ForkingDaemon.pm000644 001751 001751 00000016452 12143730314 017160 0ustar00bingosbingos000000 000000 # vim: ts=2 sw=2 expandtab use strict; use warnings; # companion to t/90_regression/rt65460-forking.t use POE::Filter::Reference; use IO::Handle; use POSIX; use Carp; my $debug = 0; main(); # basically ripped off from SimpleDBI::SubProcess sub main { # Autoflush to avoid weirdness $|++; # set binmode, thanks RT #43442 binmode( STDIN ); binmode( STDOUT ); my $filter = POE::Filter::Reference->new(); # Okay, now we listen for commands from our parent :) while ( sysread( STDIN, my $buffer = '', 1024 ) ) { # Feed the line into the filter my $data = $filter->get( [ $buffer ] ); # Process each data structure foreach my $input ( @$data ) { # should be hashref with data if ( $input->{debug} ) { $debug = 1; # enable tracing/asserts eval "sub POE::Kernel::TRACE_DEFAULT () { 1 };sub POE::Kernel::ASSERT_DEFAULT () { 1 };"; die $@ if $@; } do_test( $input->{file}, $input->{timing}, $input->{forked}, $input->{type} ); CORE::exit( 0 ); } } } sub do_test { my ($file,$timing,$forked,$type) = @_; my $oldpid = $$; # hook into warnings/die my $handler = sub { my $l = $_[0]; $l =~ s/(?:\r|\n)+$//; open my $fh, '>>', $file or die "Unable to open $file: $!"; $fh->autoflush( 1 ); print $fh "$l\n"; close $fh; return; }; $SIG{'__WARN__'} = $handler; $SIG{'__DIE__'} = $handler; # Load POE before daemonizing or after? if ( $timing eq 'before' ) { eval "use POE; use POE::Session;"; die $@ if $@; } # Okay, we daemonize before running POE do_daemonize( $type ); if ( $timing eq 'after' ) { eval "use POE; use POE::Session;"; die $@ if $@; } # Now we inform our test harness the PID open my $fh, '>>', $file or die "Unable to open $file: $!"; $fh->autoflush( 1 ); print $fh "OLDPID $oldpid\n"; print $fh "PID $$\n"; # start POE and do the test! POE::Kernel->has_forked if $forked eq 'has_fork'; start_poe(); # POE finished running, inform our test harness print $fh "DONE\n"; close $fh; return; } sub do_daemonize { my $type = shift; eval { if ( $type eq 'nsd' ) { nsd_daemonize(); } elsif ( $type eq 'dd' ) { dd_daemonize(); } elsif ( $type eq 'mxd' ) { mxd_daemonize(); } else { die "Unknown daemonization method: $type"; } }; die $@ if $@; return; } sub start_poe { # start POE with a basic test to see if it handled the daemonization POE::Session->create( inline_states => { _start => sub { warn "STARTING TEST" if $debug; $POE::Kernel::poe_kernel->yield( "do_test" ); return; }, do_test => sub { warn "STARTING DELAY" if $debug; $POE::Kernel::poe_kernel->delay( "done" => 1 ); return; }, done => sub { warn "DONE WITH DELAY" if $debug; return; }, }, ); POE::Kernel->run; return; } # the rest of the code in this file is # ripped off from Net::Server::Daemonize v0.05 as it does single-fork # Removed some unnecessary code like pidfile/uid/gid/chdir stuff ### routine to protect process during fork sub safe_fork () { ### block signal for fork my $sigset = POSIX::SigSet->new(SIGINT); POSIX::sigprocmask(SIG_BLOCK, $sigset) or die "Can't block SIGINT for fork: [$!]\n"; ### fork off a child my $pid = fork; unless( defined $pid ){ die "Couldn't fork: [$!]\n"; } ### make SIGINT kill us as it did before $SIG{INT} = 'DEFAULT'; ### put back to normal POSIX::sigprocmask(SIG_UNBLOCK, $sigset) or die "Can't unblock SIGINT for fork: [$!]\n"; return $pid; } ### routine to completely dissociate from ### terminal process. sub nsd_daemonize { my $pid = safe_fork(); ### parent process should do the pid file and exit if( $pid ){ $pid && CORE::exit(0); ### child process will continue on }else{ ### close all input/output and separate ### from the parent process group open STDIN, '/dev/null' or die "Can't open STDOUT to /dev/null: [$!]\n"; open STDERR, '>&STDOUT' or die "Can't open STDERR to STDOUT: [$!]\n"; ### Turn process into session leader, and ensure no controlling terminal POSIX::setsid(); return 1; } } # the rest of the code in this file is # ripped off from Daemon::Daemonize v0.0052 as it does double-fork # Removed some unnecessary code like pidfile/chdir stuff sub _fork_or_die { my $pid = fork; confess "Unable to fork" unless defined $pid; return $pid; } sub superclose { my $from = shift || 0; my $openmax = POSIX::sysconf( &POSIX::_SC_OPEN_MAX ); $openmax = 64 if ! defined( $openmax ) || $openmax < 0; return unless $from < $openmax; POSIX::close( $_ ) foreach ($from .. $openmax - 1); } sub dd_daemonize { my $close = 1; # Fork once to go into the background { if ( my $pid = _fork_or_die() ) { CORE::exit 0; } } # Create new session (POSIX::setsid) || confess "Cannot detach from controlling process"; # Fork again to ensure that daemon never reacquires a control terminal _fork_or_die() && CORE::exit 0; # Clear the file creation mask umask 0; if ( $close eq 1 || $close eq '!std' ) { # Close any open file descriptors superclose( $close eq '!std' ? 3 : 0 ); } if ( $close eq 1 || $close eq 'std' ) { # Re-open STDIN, STDOUT, STDERR to /dev/null open( STDIN, "+>/dev/null" ) or confess "Could not redirect STDIN to /dev/null"; open( STDOUT, "+>&STDIN" ) or confess "Could not redirect STDOUT to /dev/null"; open( STDERR, "+>&STDIN" ) or confess "Could not redirect STDERR to /dev/null"; # Avoid 'stdin reopened for output' warning (taken from MooseX::Daemonize) local *_NIL; open( _NIL, '/dev/null' ); <_NIL> if 0; } return 1; } # the rest of the code in this file is # ripped off from MooseX::Daemonize::Core v0.12 as it does some weird things ;) # Removed some unnecessary code like Moose stuff sub daemon_fork { if (my $pid = fork) { CORE::exit( 0 ); } else { # now in the daemon return; } } sub daemon_detach { (POSIX::setsid) # set session id || confess "Cannot detach from controlling process"; { $SIG{'HUP'} = 'IGNORE'; fork && CORE::exit; } umask 0; # clear the file creation mask # get the max numnber of possible file descriptors my $openmax = POSIX::sysconf( &POSIX::_SC_OPEN_MAX ); $openmax = 64 if !defined($openmax) || $openmax < 0; # close them all POSIX::close($_) foreach (0 .. $openmax); # fixup STDIN ... open(STDIN, "+>/dev/null") or confess "Could not redirect STDOUT to /dev/null"; # fixup STDOUT ... open(STDOUT, "+>&STDIN") or confess "Could not redirect STDOUT to /dev/null"; # fixup STDERR ... open(STDERR, "+>&STDIN") or confess "Could not redirect STDERR to /dev/null"; ; # do a little house cleaning ... # Avoid 'stdin reopened for output' # warning with newer perls open( NULLFH, '/dev/null' ); if (0); # return success return 1; } sub mxd_daemonize { daemon_fork(); daemon_detach(); } POE-1.370/mylib/gen-tests.perl000644 001751 001751 00000005503 14216613073 016674 0ustar00bingosbingos000000 000000 #!/usr/bin/perl -w # rocco // vim: ts=2 sw=2 expandtab use strict; use File::Spec; use File::Path; BEGIN { eval "require POE::Test::Loops"; if ($@) { warn "Could not load POE::Test::Loops. Skipping loop tests"; exit; } } my $test_base = "t"; ### Resources, and their perl and XS implementations. { my $base_dir = File::Spec->catfile($test_base, "20_resources"); my $base_lib = File::Spec->catfile($base_dir, "00_base"); my %derived_conf = ( "10_perl" => { implementation => "perl" }, # TODO - Enable when an XS implementation arrives. # "20_xs" => { implementation => "xs" }, ); my $source = ( "#!/usr/bin/perl -w\n" . "\n" . "use strict;\n" . "use lib qw(--base_lib--);\n" . "use Test::More;\n" . "\n" . "\$ENV{POE_IMPLEMENTATION} = '--implementation--';\n" . "\n" . "require '--base_file--';\n" . "\n" . "CORE::exit 0;\n" ); derive_files( base_dir => $base_dir, base_lib => $base_lib, derived_conf => \%derived_conf, src_template => $source, ); } ### Event loops and the tests that love them. { my $base_dir = File::Spec->catfile($test_base, "30_loops"); my @loops = qw(Select IO::Poll); POE::Test::Loops::generate($base_dir, \@loops); } exit 0; sub derive_files { my %conf = @_; my $base_dir = $conf{base_dir}; # Gather the list of base files. Each will be used to generate a # real test file. opendir BASE, $conf{base_lib} or die $!; my @base_files = grep /\.pm$/, readdir(BASE); closedir BASE; # Generate a set of test files for each configuration. foreach my $dst_dir (keys %{$conf{derived_conf}}) { my $full_dst = File::Spec->catfile($base_dir, $dst_dir); $full_dst =~ tr[/][/]s; $full_dst =~ s{/+$}{}; my %template_conf = %{$conf{derived_conf}{$dst_dir}}; # Blow away any previously generated test files. rmtree($full_dst); mkpath($full_dst, 0, 0755); # For each base file, generate a corresponding one in the # configured destination directory. Expand various bits to # customize the test. foreach my $base_file (@base_files) { my $full_file = File::Spec->catfile($full_dst, $base_file); $full_file =~ s/\.pm$/.t/; # These hardcoded expansions are for the base file to be # required, and the base library directory where it'll be found. my $expanded_src = $conf{src_template}; $expanded_src =~ s/--base_file--/$base_file/g; $expanded_src =~ s/--base_lib--/$conf{base_lib}/g; # The others are plugged in from the directory configuration. while (my ($key, $val) = each %template_conf) { $expanded_src =~ s/--\Q$key\E--/$val/g; } # Write with lots of error checking. open EXPANDED, ">$full_file" or die $!; print EXPANDED $expanded_src; close EXPANDED or die $!; } } } POE-1.370/mylib/cpan-test.perl000644 001751 001751 00000007551 12143730314 016661 0ustar00bingosbingos000000 000000 #!/usr/bin/perl # Fetch and test all the /^POE::/ distributions on CPAN. use strict; use CPANPLUS::Configure; use CPANPLUS::Backend; use Cwd; use Digest::MD5; ### Local configuration. Do everything out of the current directory, ### which is usually (always?) the main POE development directory. my $cwd = cwd; sub DIR_MAIN () { $cwd . "/comptest" } sub DIR_CPANPLUS () { DIR_MAIN . "/cpanplus" } sub DIR_TARBALLS () { DIR_MAIN . "/tarballs" } sub DIR_TESTING () { DIR_CPANPLUS . "/build" } ### Create directories as necessary. unless (-e DIR_MAIN) { mkdir DIR_MAIN, 0777 or die $!; } unless (-e DIR_CPANPLUS) { mkdir DIR_CPANPLUS, 0777 or die $!; } unless (-e DIR_TARBALLS) { mkdir DIR_TARBALLS, 0777 or die $!; } ### Grab CPANPLUS' configuration, and locally redirect its base ### directory to our own location. my $cc = CPANPLUS::Configure->new(); $cc->set_conf( base => DIR_CPANPLUS ); ### Gather a list of POE components that aren't distributed with POE. print "Searching CPAN for POE distributions...\n"; my $cp = CPANPLUS::Backend->new($cc); my @search = $cp->search( type => "module", allow => [ qr/^POE::/ ], ); my %package; foreach my $obj (sort @search) { my $package = $obj->package(); my ($pkg, $ver) = ($package =~ /^(.*?)-([0-9\.\_]+)\.tar\.gz$/); # Skip things indigenous to POE. unless (defined $pkg) { warn "Skipping $package (can't parse package name)...\n"; next; } next if $pkg eq "POE"; $package{$package} = $obj; } ### Fetch distributions. This caches them in DIR_TARBALLS, avoiding ### redundant downloads. print "Fetching distributions...\n"; foreach my $package (sort keys %package) { my $existing_file = DIR_TARBALLS . "/$package"; print "Got ", $package{$package}->fetch( fetchdir => DIR_TARBALLS ), "\n"; } ### Remove unsuccessful downloads. Also remove older versions of ### updated distributions. my %ver; opendir(TB, DIR_TARBALLS) or die $!; foreach (readdir(TB)) { my $full_path = DIR_TARBALLS . "/$_"; next unless -f $full_path; if (/-\d+$/) { print "Unlinked stale temporary $full_path\n"; unlink $full_path; next; } my ($mod, $ver) = (/^(.*?)-([0-9\.\_]+)\.tar\.gz$/); die "Can't parse $_ into dist/version" unless defined $mod and defined $ver; if (exists $ver{$mod}) { push @{$ver{$mod}}, $full_path; } else { $ver{$mod} = [$full_path]; } } closedir TB; foreach my $mod (sort keys %ver) { next unless @{$ver{$mod}} > 1; my @files = sort { (-M $a) <=> (-M $b) } @{$ver{$mod}}; while (@files > 1) { my $dead = pop @files; print "Unlinking older $dead...\n"; unlink $dead; } } ### Test them! # Trap SIGINT and exit gracefully, so the END block below gets a # chance to run. $SIG{INT} = sub { exit }; # Add my cvspoe directory to the include path. if (exists $ENV{PERL5LIB}) { $ENV{PERL5LIB} .= ":/home/troc/perl/poe"; } else { $ENV{PERL5LIB} = "/home/troc/perl/poe"; } opendir(TB, DIR_TARBALLS) or die $!; my @tarballs = grep { -f } map { DIR_TARBALLS . "/$_" } readdir TB; close TB; my %results; foreach my $tarball (@tarballs) { # Temporarily skip some modules that hang during testing. if ($tarball =~ /(rrdtool|onjoin|player)/i) { warn "Skipping $tarball...\n"; next; } warn "Testing $tarball...\n"; system("/bin/rm -rf " . DIR_TESTING); mkdir DIR_TESTING, 0777 or die $!; $cp->extract(files => [ $tarball ]); my $mod = $tarball; $mod =~ s/^.*\///; $mod =~ s/\.tar.gz$//; my $full_dir = DIR_TESTING . "/$mod"; warn $full_dir; my $local_results = $cp->make( target => "test", dirs => [ $full_dir ], ); while (my ($dir, $stat) = each %$local_results) { $results{$dir} = $stat; } } ### Print summary of results. END{ foreach my $dir (sort keys %results) { my $mod = $dir; $mod =~ s/^.*\///; print( $results{$dir}, " = ", ($results{$dir}) ? " " : "NOT" ); print " OK $mod\n"; } } POE-1.370/mylib/PoeBuildInfo.pm000644 001751 001751 00000004270 12472121170 016746 0ustar00bingosbingos000000 000000 # vim: ts=2 sw=2 expandtab # Build information for POE. Moved into a library so it can be # required by Makefile.PL and gen-meta.perl. package PoeBuildInfo; use strict; use Exporter; use vars qw(@ISA @EXPORT_OK); push @ISA, qw(Exporter); @EXPORT_OK = qw( TEST_FILES CLEAN_FILES CORE_REQUIREMENTS DIST_ABSTRACT DIST_AUTHOR CONFIG_REQUIREMENTS REPOSITORY HOMEPAGE ); sub CONFIG_REQUIREMENTS () { ( "POE::Test::Loops" => '1.360', ); } sub CORE_REQUIREMENTS () { my @core_requirements = ( "Carp" => 0, "Errno" => 1.09, "Exporter" => 0, "File::Spec" => 0.87, "IO" => 1.24, # MSWin32 blocking(0) "IO::Handle" => 1.27, "IO::Pipely" => 0.005, "POSIX" => 1.02, "Socket" => 1.7, "Storable" => 2.16, "Test::Harness" => 2.26, "Time::HiRes" => 1.59, CONFIG_REQUIREMENTS, ); if ($^O eq "MSWin32") { push @core_requirements, ( "Win32::Console" => 0.031, "Win32API::File" => 0.05, "Win32::Job" => 0.03, "Win32::Process" => 0, "Win32" => 0, ); } elsif ($^O eq 'cygwin') { # Skip IO::Tty. It has trouble building as of this writing. } else { push @core_requirements, ( "IO::Tty" => 1.08, # avoids crashes on fbsd ); } return @core_requirements; } sub DIST_AUTHOR () { ( 'Rocco Caputo ' ) } sub DIST_ABSTRACT () { ( 'Portable, event-loop agnostic eventy networking and multitasking.' ) } sub CLEAN_FILES () { my @clean_files = qw( */*/*/*/*~ */*/*/*~ */*/*/*~ */*/*~ */*~ *~ META.yml Makefile.old bingos-followtail coverage.report poe_report.xml run_network_tests t/20_resources/10_perl t/20_resources/10_perl/* t/20_resources/20_xs t/20_resources/20_xs/* t/30_loops t/30_loops/* t/30_loops/*/* test-output.err ); "@clean_files"; } sub TEST_FILES () { my @test_files = qw( t/*.t t/*/*.t t/*/*/*.t ); "@test_files"; } sub REPOSITORY () { 'https://github.com/rcaputo/poe' } sub HOMEPAGE () { 'http://poe.perl.org/' } 1; POE-1.370/mylib/Devel/Null.pm000644 001751 001751 00000001543 12143730314 016401 0ustar00bingosbingos000000 000000 # This `perl -d` debugging module is an ad-hoc custom debugger. It's # optional, and it may not even work. use strict; package Null; # satisfies 'use' package DB; use vars qw($sub); use Carp; # This bit traces execution immediately before a given condition. # It's used to find out where in hell something went wrong. my @trace = ("no step") x 16; sub DB { my ($package, $file, $line) = caller; my $discard = shift @trace; push @trace, "step @ $file:$line: "; if ( defined($POE::Kernel::poe_kernel) and @{$POE::Kernel::poe_kernel->[8]} and $POE::Kernel::poe_kernel->[8]->[0]->[2] =~ /\-\ 1); croak "POE::Session and POE::NFA export conflicting constants" if scalar @sessions > 1; # If a session was specified, use that. Otherwise use Session. if (@sessions) { unshift @modules, @sessions; } else { unshift @modules, 'Session'; } my $package = caller(); my @failed; # Load POE::Kernel in the caller's package. This is separate # because we need to push POE::Loop classes through POE::Kernel's # import(). { my $loop = ""; if (@loops) { $loop = "{ loop => '" . shift (@loops) . "' }"; } my $code = "package $package; use POE::Kernel $loop;"; # warn $code; eval $code; if ($@) { warn $@; push @failed, "Kernel" } } # Load all the others. foreach my $module (@modules) { my $code = "package $package; use POE::$module;"; # warn $code; eval($code); if ($@) { warn $@; push(@failed, $module); } } @failed and croak "could not import qw(" . join(' ', @failed) . ")"; } 1; __END__ =head1 NAME POE - portable multitasking and networking framework for any event loop =head1 SYNOPSIS #!/usr/bin/perl use warnings; use strict; use POE; # Auto-includes POE::Kernel and POE::Session. sub handler_start { my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION]; print "Session ", $session->ID, " has started.\n"; $heap->{count} = 0; $kernel->yield('increment'); } sub handler_increment { my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION]; print "Session ", $session->ID, " counted to ", ++$heap->{count}, ".\n"; $kernel->yield('increment') if $heap->{count} < 10; } sub handler_stop { print "Session ", $_[SESSION]->ID, " has stopped.\n"; } for (1..10) { POE::Session->create( inline_states => { _start => \&handler_start, increment => \&handler_increment, _stop => \&handler_stop, } ); } POE::Kernel->run(); exit; =head1 DESCRIPTION POE is a framework for cooperative, event driven multitasking and networking in Perl. Other languages have similar frameworks. Python has Twisted. TCL has "the event loop". POE provides a unified interface for several other event loops, including select(), L, L, L, L, L, and L. Many of these event loop interfaces were written by others, with the help of POE::Test::Loops. They may be found on the CPAN. POE achieves its high degree of portability to different operating systems and Perl versions by being written entirely in Perl. CPAN hosts optional XS modules for POE if speed is more desirable than portability. POE is designed in layers. Each layer builds atop the lower level ones. Programs are free to use POE at any level of abstraction, and different levels can be mixed and matched seamlessly within a single program. Remember, though, that higher-level abstractions often require more resources than lower-level ones. The conveniences they provide are not free. POE's bundled abstraction layers are the tip of a growing iceberg. L, L, and other CPAN distributions build upon this work. You're encouraged to look around. No matter how high you go, though, it all boils down to calls to L. So your down-to-earth code can easily cooperate with stratospheric systems. =head2 Layer 1: Kernel and Sessions The lowest public layer is comprised of L, L, and other session types. L does most of the heavy lifting. It provides a portable interface for filehandle activity detection, multiple alarms and other timers, signal handling, and other less-common features. L and derived classes encapsulate the notion of an event driven task. They also customize event dispatch to a particular calling convention. L, for example, is more of a proper state machine. The CPAN has several other kinds of sessions. Everything ultimately builds on these classes or the concepts they implement. If you're short on time, the things to read besides this are L and L. =head2 Layer 2: Wheels, Filters, and Drivers POE::Wheel objects are dynamic mix-ins for POE::Session instances. These "wheels" perform very common, generic tasks in a highly reusable and customizable way. L, for example, implements non-blocking buffered I/O. Nearly everybody needs this, so why require people to reinvent it all the time? L objects customize wheels in a modular way. Filters act as I/O layers, turning raw streams into structured data, and serializing structures into something suitable for streams. The CPAN also has several of these. Drivers are where the wheels meet the road. In this case, the road is some type of file handle. Drivers do the actual reading and writing in a standard way so wheels don't need to know the difference between send() and syswrite(). L objects get relatively short shrift because very few are needed. The most common driver, L is ubiquitous and also the default, so most people will never need to specify one. =head2 Layer 3: Components L classes are essentially Perl classes that use POE to perform tasks in a non-blocking or cooperative way. This is a very broad definition, and POE components are all over the abstraction map. Many components, such as L, encapsulate the generic details of an entire application. Others perform rather narrow tasks, such as L. POE components are often just plain Perl objects. The previously mentioned L uses L. Other object and meta-object frameworks are compatible. Also of interest is L, which allows you to create a POE component from nearly any blocking module. There are quite a lot of components on the CPAN. L =head2 Layer 4 and Beyond: Frameworks and Object Metaphors It's possible to abstract POE entirely behind a different framework. In fact we encourage people to write domain-specific abstractions that entirely hide POE if necessary. The nice thing here is that even at these high levels of abstraction, things will continue to interoperate all the way down to layer 1. Two examples of ultra-high level abstraction are L, a networking framework that does its own thing, and L, which is POE's creator's attempt to formalize and standardize POE components. It is also possible to communicate between POE processes. This is called IKC, for I. There are a few IKC components on the CPAN (L), notably L and L. =head2 Layer 0: POE's Internals POE's layered architecture continues below the surface. POE's guts are broken into specific L classes for each event loop it supports. Internals are divided up by type, giving L classes for Aliases, Controls, Events, Extrefs, FileHandles, SIDs, Sessions and Signals. POE::Kernel's APIs are extensible through POE::API mix-in classes. Some brave souls have even published new APIs on CPAN, such as L (which gives you access to some of the internal L methods). By design, it's possible to implement new L guts by creating another L class. One can then expose the functionality with a new POE::API mix-in. =head1 DOCUMENTATION ROADMAP You're reading the main POE documentation. It's the general entry point to the world of POE. You already know this, however, so let's talk about something more interesting. =head2 Basic Features POE's basic features are documented mainly in L and L. Methods are documented in the classes that implement them. Broader concepts are covered in the most appropriate class, and sometimes they are divided among classes that share in their implementation. =head2 Basic Usage Basic usage, even for POE.pm, is documented in L. That's where most of POE's work is done, and POE.pm is little more than a class loader. =head2 @_[KERNEL, HEAP, etc.] Event handler calling conventions, that weird C<@_[KERNEL, HEAP]> stuff, is documented in L. That's because POE::Session implements the calling convention, and other session types often do it differently. =head2 Base Classes Document Common Features The L, L, L, and L base classes describe what's common among each class. It's a good idea to at least skim the base class documentation since the subclasses tend not to rehash the common things. L, L, and L document the concepts and sometimes the standard interfaces behind multiple subclasses. You're encouraged to have a look. =head2 Helper Classes POE includes some helper classes for portability. L, and its subclasses L and L are portable pipes. =head2 Event Loop Bridges L documents and specifies the interface for all of POE's event loop bridges. The individual classes may document specific details, but generally they adhere to the spec strongly enough that they don't need to. Many of the existing L bridges provided in POE's base distribution will move out to separate distributions shortly. The documentation will probably remain the same, however. =head2 POE::Queue and POE::Queue::Array POE's event queue is basically a priority heap implemented as an ordered array. L documents the standard interface for POE event queues, and L implements the ordered array queue. Tony Cook has released L, which is a drop-in C replacement for L. You might give it a try if you need more performance. POE's event queue is some of the hottest code in the system. =head2 This Section Isn't Complete Help organize the documentation. Obviously we can't think of everything. We're well aware of this and welcome audience participation. =head2 See SEE ALSO Wherever possible, the SEE ALSO section will cross-reference one module to related ones. =head2 Don't Forget the Web Finally, there are many POE resources on the web. The CPAN contains a growing number of POE modules. L hosts POE's wiki, which includes tutorials, an extensive set of examples, documentation, and more. Plus it's a wiki, so you can trivially pitch in your two cents. =head1 SYSTEM REQUIREMENTS POE's basic requirements are rather light. Most are included with modern versions of Perl, and the rest (if any) should be generally portable by now. L is highly recommended, even for older Perls that don't include it. POE will work without it, but alarms and other features will be much more accurate if it's included. L will use Time::HiRes automatically if it's available. L needs a module to serialize data for transporting it across a network. It will use L, L, L, or some other package with freeze() and thaw() methods. It can also use L to conserve bandwidth and reduce latency over slow links, but it's not required. If you want to write web servers, you'll need to install libwww-perl, which requires libnet. This is a small world of modules that includes L, L, L, and L. They are generally good to have, and modern versions of Perl even include them. Programs that use L will of course require the L module, which in turn requires some sort of curses library. If you're using POE with Tk, you'll need L installed. And other obvious things. Let us know if we've overlooked a non-obvious detail. =head1 COMPATIBILITY ISSUES One of POE's design goals is to be as portable as possible. That's why it's written in "Plain Perl". XS versions of POE modules are available as third-party distributions. Parts of POE that require nonstandard libraries are optional, and not having those libraries should not prevent POE from installing. Despite Chris Williams' efforts, we can't test POE everywhere. Please see the GETTING HELP section if you run into a problem. POE is expected to work on most forms of UNIX, including FreeBSD, MacOS X, Linux, Solaris. Maybe even AIX and QNX, but we're not sure. POE is also tested on Windows XP, using the latest version of ActiveState, Strawberry and Cygwin Perl. POE is fully supported with Strawberry Perl, as it's included in the Strawberry distribution. OS/2 and MacOS 9 have been reported to work in the past, but nobody seems to be testing there anymore. Reports and patches are still welcome. Past versions of POE have been tested with Perl versions as far back as 5.6.2 and as recent as "blead", today's development build. We can no longer guarantee each release will work everywhere, but we will be happy to work with you if you need special support for a really old system. You can always use older POE releases that works on your version, please check L. POE's quality is due in large part to the fine work of Chris Williams and the other CPAN testers. They have dedicated resources towards ensuring CPAN distributions pass their own tests, and we watch their reports religiously. You can, too. The latest POE test reports can be found at L. Thanks also go out to Benjamin Smith and the 2006 Google Summer of Code. Ben was awarded a grant to improve POE's test suite, which he did admirably. =head2 Windows Issues POE seems to work very nicely with Perl compiled for Cygwin. If you must use ActiveState Perl, please use the absolute latest version. ActiveState Perl's compatibility fluctuates from one build to another, so we tend not to support older releases. Windows and ActiveState Perl are considered an esoteric platform due to the complex interactions between various versions. POE therefore relies on user feedback and support here. A number of people have helped bring POE's Windows support this far, through contributions of time, patches, and other resources. Some of them are: Sean Puckett, Douglas Couch, Andrew Chen, Uhlarik Ondoej, Nick Williams, and Chris Williams (no relation). =head2 Linux/Unix Issues =head3 pty woes Some distributions chose to not completely setup the pseudo-tty support. This is needed for L to interact with the subprocess. If you see something like this while running C please look at your distribution's documentation on how to fix it. For example, on Debian-based systems the solution was to execute "sudo apt-get install udev". t/30_loops/io_poll/wheel_run.t ..................... 1/99 pty_allocate(nonfatal): posix_openpt(): No such file or directory at /usr/local/lib/perl/5.10.0/IO/Pty.pm line 24. ... Cannot open a pty at /home/apoc/poe/blib/lib/POE/Wheel/Run.pm line 251 Compilation failed in require at t/30_loops/io_poll/wheel_run.t line 24. # Looks like you planned 99 tests but ran 5. # Looks like your test exited with 22 just after 5. t/30_loops/io_poll/wheel_run.t ..................... Dubious, test returned 22 (wstat 5632, 0x1600) =head2 Other Compatibility Issues None currently known. See GETTING HELP below if you've run into something. =head1 GETTING HELP POE's developers take pride in its quality. If you encounter a problem, please let us know. =head2 POE's Request Tracker You're welcome to e-mail questions and bug reports to . This is not a realtime support channel, though. If you need a more immediate response, try one of the methods below. =head2 POE's Mailing List POE has a dedicated mailing list where developers and users discuss the software and its use. You're welcome to join us. Send an e-mail to for subscription instructions. The subject and message body are ignored. =head2 POE's Web Site contains recent information, tutorials, and examples. It's also a wiki, so people are invited to share tips and code snippets there as well. =head2 POE's Source Code The following command will fetch the most current version of POE into the "poe" subdirectory: git clone https://github.com/rcaputo/poe.git =head2 SourceForge http://sourceforge.net/projects/poe/ is POE's project page. =head2 Internet Relay Chat (IRC) irc.perl.org channel #poe is an informal place to waste some time and maybe even discuss Perl and POE. Consider an SSH relay if your workplace frowns on IRC. But only if they won't fire you if you're caught. =head2 Personal Support Unfortunately we don't have resources to provide free one-on-one personal support anymore. We'll do it for a fee, though. Send Rocco an e-mail via his CPAN address. =head1 SEE ALSO Broken down by abstraction layer. =head2 Layer 1 L, L, L =head2 Layer 2 L, L, L, L, L, L, L, L L, L L, L, L, L, L, L, L, L, L, L =head2 Layer 3 L, L, L =head2 Layer 0 L, L, L, L, L, L L, L L, L, L, L, L, L, L, L =head2 Helpers L, L, L =head2 Home Page http://poe.perl.org/ =head2 Bug Tracker https://rt.cpan.org/Dist/Display.html?Status=Active&Queue=POE =head2 Repositories and Changes You can browse the POE source and complete change logs at https://github.com/rcaputo/poe. It also provides an RSS news feed for those who want to follow development in near-realtime. =head2 Other Resources https://metacpan.org/module/POE http://search.cpan.org/dist/POE =head1 AUTHORS & COPYRIGHT POE is the combined effort of quite a lot of people. This is an incomplete list of some early contributors. A more complete list can be found in POE's change log. =over 2 =item Ann Barcomb Ann Barcomb is , aka C. Ann contributed large portions of POE::Simple and the code that became the ReadWrite support in POE::Component::Server::TCP. Her ideas also inspired Client::TCP component, introduced in version 0.1702. =item Artur Bergman Artur Bergman is . He contributed many hours' work into POE and quite a lot of ideas. Years later, I decide he's right and actually implement them. Artur is the author of Filter::HTTPD and Filter::Reference, as well as bits and pieces throughout POE. His feedback, testing, design and inspiration have been instrumental in making POE what it is today. Artur is investing his time heavily into perl 5's iThreads and PONIE at the moment. This project has far-reaching implications for POE's future. =item Jos Boumans Jos Boumans is , aka C. Jos is a major driving force behind the POE::Simple movement and has helped inspire the POE::Components for TCP clients and servers. =item Matt Cashner Matt Cashner is , aka C. Matt is one of POE's core developers. He's spearheaded the movement to simplify POE for new users, flattening the learning curve and making the system more accessible to everyone. He uses the system in mission critical applications, folding feedback and features back into the distribution for everyone's enjoyment. =item Andrew Chen Andrew Chen is . Andrew is the resident POE/Windows guru. He contributes much needed testing for Solaris on the SPARC and Windows on various Intel platforms. =item Douglas Couch Douglas Couch is . Douglas helped port and maintain POE for Windows early on. =item Jeffrey Goff Jeffrey Goff is . Jeffrey is the author of several POE modules, including a tokenizing filter and a component for managing user information, PoCo::UserBase. He's also co-author of "A Beginner's Introduction to POE" at www.perl.com. =item Philip Gwyn Philip Gwyn is . He extended the Wheels I/O abstraction to support hot-swappable filters, and he eventually convinced Rocco that unique session and kernel IDs were a good thing. Philip also enhanced L to support different serialization methods. He has also improved POE's quality by finding and fixing several bugs. He provided POE a much needed code review around version 0.06. Lately, Philip tracked down the race condition in signal handling and fixed it with the signal pipe. =item Arnar M. Hrafnkelsson Arnar is . Addi tested POE and L on Windows, finding bugs and testing fixes. He appears throughout the Changes file. He has also written "cpoe", which is a POE-like library for C. =item Dave Paris Dave Paris is . Dave tested and benchmarked POE around version 0.05, discovering some subtle (and not so subtle) timing problems. The pre-forking server sample was his idea. Versions 0.06 and later scaled to higher loads because of his work. He has contributed a lot of testing and feedback, much of which is tagged in the Changes file as a-mused. The man is scarily good at testing and troubleshooting. =item Dieter Pearcey Dieter Pearcey is . He goes by several Japanese nicknames. Dieter's current area of expertise is in Wheels and Filters. He greatly improved L, and his Filter contributions include the basic Block filter, as well as Stackable, RecordBlock, Grep and Map. =item Plixer International Plixer International is at L. Their sponsorship has helped POE 1.300 and beyond be significantly more robust using iThreads, especially when using fork() in Windows. =item Robert Seifer Robert Seifer is . He rotates IRC nicknames regularly. Robert contributed entirely too much time, both his own and his computers, towards the detection and eradication of a memory corruption bug that POE tickled in earlier Perl versions. In the end, his work produced a simple compile-time hack that worked around a problem relating to anonymous subs, scope and @{} processing. =item Matt Sergeant Matt contributed C, a more efficient way to watch multiple files than select(). It's since been moved to L. =item Richard Soderberg Richard Soderberg is , aka C. Richard is a collaborator on several side projects involving POE. His work provides valuable testing and feedback from a user's point of view. =item Dennis Taylor Dennis Taylor is . Dennis has been testing, debugging and patching bits here and there, such as Filter::Line which he improved by leaps in 0.1102. He's also the author of L, the widely popular POE-based successor to his wildly popular L library. =item David Davis David Davis, aka Xantus is . David contributed patches to the HTTPD filter, and added CALLER_STATE to L. He is the author of L, a networking framework built on POE. =item Others? Please contact the author if you've been forgotten and would like to be included here. =for comment TODO - This section has fallen into disrepair. A POE historian needs to cull the CHANGES for the names of major contributors. =back =head2 Author =over 2 =item Rocco Caputo Rocco Caputo is . POE is his brainchild. He wishes to thank you for your interest, and he has more thanks than he can count for all the people who have contributed. POE would not be nearly as cool without you. Except where otherwise noted, POE is Copyright 1998-2013 Rocco Caputo. All rights reserved. POE is free software; you may redistribute it and/or modify it under the same terms as Perl itself. =back Thank you for reading! =cut # rocco // vim: ts=2 sw=2 expandtab # TODO - Edit. POE-1.370/lib/POE/Filter/000755 001751 001751 00000000000 14216613074 015377 5ustar00bingosbingos000000 000000 POE-1.370/lib/POE/Driver/000755 001751 001751 00000000000 14216613074 015405 5ustar00bingosbingos000000 000000 POE-1.370/lib/POE/Resource/000755 001751 001751 00000000000 14216613074 015741 5ustar00bingosbingos000000 000000 POE-1.370/lib/POE/Driver.pm000644 001751 001751 00000011537 14216606677 015765 0ustar00bingosbingos000000 000000 package POE::Driver; use strict; use vars qw($VERSION); $VERSION = '1.370'; # NOTE - Should be #.### (three decimal places) use Carp qw(croak); #------------------------------------------------------------------------------ sub new { my $type = shift; croak "$type is not meant to be used directly"; } #------------------------------------------------------------------------------ 1; __END__ =head1 NAME POE::Driver - an abstract interface for buffered, non-blocking I/O =head1 SYNOPSIS This is a contrived example of how POE::Filter and POE::Driver objects may be used in a stand-alone application. my $driver = POE::Driver::SysRW->new(); my $filter = POE::Filter::Line->new(); my $list_of_octet_chunks = $filter->put("A line of text."); $driver->put( $list_of_octet_chunks ); my $octets_remaining_in_buffer = $driver->flush($filehandle); die "couldn't flush everything" if $octets_remaining_in_buffer; while (1) { my $octets_list = $driver->get($filehandle); die $! unless defined $octets_list; $filter->get_one_start($octets_list); while (my $line = $filter->get_one()) { print "Input: $line\n"; } } Most programs will use POE::Filter and POE::Driver objects as parameters to POE::Wheel constructors. See the synopses for particular classes for details. =head1 DESCRIPTION POE::Driver is a common API for I/O drivers that can read from and write to various files, sockets, pipes, and other devices. POE "drivers" implement the specifics of reading and writing to devices. Drivers plug into POE::Wheel objects so that wheels may support a large number of device types without implementing a separate subclass for each. As mentioned in the SYNOPSIS, POE::Driver objects may be used in stand-alone applications. =head2 Public Driver Methods These methods are the generic Driver interface, and every driver must implement them. Specific drivers may have additional methods related to their particular tasks. =head3 new new() creates, initializes, and returns a new driver. Specific drivers may have different constructor parameters. The default constructor parameters should configure the driver for the most common use case. =head3 get FILEHANDLE get() immediately tries to read information from a FILEHANDLE. It returns an array reference on success---even if nothing was read from the FILEHANDLE. get() returns undef on error, and $! will be set to the reason why get() failed. The returned arrayref will be empty if nothing was read from the FILEHANDLE. In an EOF condition, get() returns undef with the numeric value of $! set to zero. The arrayref returned by get() is suitable for passing to any POE::Filter's get() or get_one_start() method. Wheels do exactly this internally. =over =item put ARRAYREF put() accepts an ARRAYREF of raw octet chunks. These octets are added to the driver's internal output queue or buffer. put() returns the number of octets pending output after the new octets are buffered. Some drivers may flush data immediately from their put() methods. =item flush FILEHANDLE flush() attempts to write a driver's buffered data to a given FILEHANDLE. The driver should flush as much data as possible in a single flush() call. flush() returns the number of octets remaining in the driver's output queue or buffer after the maximum amount of data has been written. flush() denotes success or failure by the value of $! after it returns. $! will always numerically equal zero on success. On failure, $! will contain the usual Errno value. In either case, flush() will return the number of octets in the driver's output queue. =item get_out_messages_buffered get_out_messages_buffered() returns the number of messages enqueued in the driver's output queue, rounded up to the nearest whole message. Some applications require the message count rather than the octet count. Messages are raw octet chunks enqueued by put(). The following put() call enqueues two messages for a total of six octets: $filter->put( [ "one", "two" ] ); It is possible for a flush() call to write part of a message. A partial message still counts as one message. =back =head1 SEE ALSO The SEE ALSO section in L contains a table of contents covering the entire POE distribution. L - A base class for POE::Session mix-ins. L - A base class for data parsers and serializers. L - A driver that encapsulates sysread() and buffered syswrite(). =head1 BUGS There is no POE::Driver::SendRecv, but nobody has needed one so far. sysread() and syswrite() manage to do almost everything people need. In theory, drivers should be pretty much interchangeable. In practice, there seems to be an impermeable barrier between the different SOCK_* types. =head1 AUTHORS & COPYRIGHTS Please see L for more information about authors and contributors. =cut # rocco // vim: ts=2 sw=2 expandtab # TODO - Edit. POE-1.370/lib/POE/Pipe/000755 001751 001751 00000000000 14216613074 015047 5ustar00bingosbingos000000 000000 POE-1.370/lib/POE/Resources.pm000644 001751 001751 00000004065 14216606677 016502 0ustar00bingosbingos000000 000000 package POE::Resources; use strict; use vars qw($VERSION); $VERSION = '1.370'; # NOTE - Should be #.### (three decimal places) my @resources = qw( POE::XS::Resource::Aliases POE::XS::Resource::Events POE::XS::Resource::Extrefs POE::XS::Resource::FileHandles POE::XS::Resource::SIDs POE::XS::Resource::Sessions POE::XS::Resource::Signals ); sub load { my $package = (caller())[0]; foreach my $resource (@resources) { eval "package $package; use $resource"; if ($@) { # Retry the resource, removing XS:: if it couldn't be loaded. # If there's no XS:: to be removed, fall through and die. redo if $@ =~ /Can't locate.*?in \@INC/ and $resource =~ s/::XS::/::/; die; } } } 1; __END__ =head1 NAME POE::Resources - loader of POE resources =head1 SYNOPSIS # Intended for internal use by POE::Kernel. use POE::Resources; POE::Resources->load(); =head1 DESCRIPTION POE::Kernel is internally split into different resources that are separately managed by individual mix-in classes. POE::Resources is designed as a high-level macro manager for POE::Resource classes. Currently it implements a single method, load(), which loads all the POE::Resource classes. =head1 METHODS POE::Resources has a public interface, but it is intended to be used internally by POE::Kernel. Application programmers should never need to use POE::Resources directly. =head2 load POE::Kernel calls load() to loads all the known POE::Resource modules. Each resource may be handled by a pure perl module, or by an XS module. For each resource class, load() first tries to load the C version of the module. If that fails, load() falls back to C. =head1 SEE ALSO See L for public information about POE resources. See L for general discussion about resources and the classes that manage them. =head1 AUTHORS & LICENSING Please see L for more information about its authors, contributors, and POE's licensing. =cut # rocco // vim: ts=2 sw=2 expandtab # TODO - Edit. POE-1.370/lib/POE/NFA.pm000644 001751 001751 00000100253 14216606677 015130 0ustar00bingosbingos000000 000000 package POE::NFA; use strict; use vars qw($VERSION); $VERSION = '1.370'; # NOTE - Should be #.### (three decimal places) use Carp qw(carp croak); sub SPAWN_INLINES () { 'inline_states' } sub SPAWN_OBJECTS () { 'object_states' } sub SPAWN_PACKAGES () { 'package_states' } sub SPAWN_OPTIONS () { 'options' } sub SPAWN_RUNSTATE () { 'runstate' } sub OPT_TRACE () { 'trace' } sub OPT_DEBUG () { 'debug' } sub OPT_DEFAULT () { 'default' } sub OPT_IMMEDIATE () { 'immediate' } sub EN_DEFAULT () { '_default' } sub EN_START () { '_start' } sub EN_STOP () { '_stop' } sub EN_SIGNAL () { '_signal' } sub NFA_EN_GOTO_STATE () { 'poe_nfa_goto_state' } sub NFA_EN_POP_STATE () { 'poe_nfa_pop_state' } sub NFA_EN_PUSH_STATE () { 'poe_nfa_push_state' } sub NFA_EN_STOP () { 'poe_nfa_stop' } sub SELF_RUNSTATE () { 0 } sub SELF_OPTIONS () { 1 } sub SELF_STATES () { 2 } sub SELF_ID () { 3 } sub SELF_CURRENT () { 4 } sub SELF_STATE_STACK () { 5 } sub SELF_INTERNALS () { 6 } sub SELF_CURRENT_NAME () { 7 } sub SELF_IS_IN_INTERNAL () { 8 } sub STACK_STATE () { 0 } sub STACK_EVENT () { 1 } #------------------------------------------------------------------------------ # Shorthand for defining a trace constant. sub _define_trace { no strict 'refs'; local $^W = 0; foreach my $name (@_) { next if defined *{"TRACE_$name"}{CODE}; if (defined *{"POE::Kernel::TRACE_$name"}{CODE}) { eval( "sub TRACE_$name () { " . *{"POE::Kernel::TRACE_$name"}{CODE}->() . "}" ); die if $@; } else { eval "sub TRACE_$name () { TRACE_DEFAULT }"; die if $@; } } } #------------------------------------------------------------------------------ BEGIN { # ASSERT_DEFAULT changes the default value for other ASSERT_* # constants. It inherits POE::Kernel's ASSERT_DEFAULT value, if # it's present. unless (defined &ASSERT_DEFAULT) { if (defined &POE::Kernel::ASSERT_DEFAULT) { eval( "sub ASSERT_DEFAULT () { " . &POE::Kernel::ASSERT_DEFAULT . " }" ); } else { eval 'sub ASSERT_DEFAULT () { 0 }'; } }; # TRACE_DEFAULT changes the default value for other TRACE_* # constants. It inherits POE::Kernel's TRACE_DEFAULT value, if # it's present. unless (defined &TRACE_DEFAULT) { if (defined &POE::Kernel::TRACE_DEFAULT) { eval( "sub TRACE_DEFAULT () { " . &POE::Kernel::TRACE_DEFAULT . " }" ); } else { eval 'sub TRACE_DEFAULT () { 0 }'; } }; _define_trace("DESTROY"); } #------------------------------------------------------------------------------ # Export constants into calling packages. This is evil; perhaps # EXPORT_OK instead? The parameters NFA has in common with SESSION # (and other sessions) must be kept at the same offsets as each-other. sub OBJECT () { 0 } sub MACHINE () { 1 } sub KERNEL () { 2 } sub RUNSTATE () { 3 } sub EVENT () { 4 } sub SENDER () { 5 } sub STATE () { 6 } sub CALLER_FILE () { 7 } sub CALLER_LINE () { 8 } sub CALLER_STATE () { 9 } sub ARG0 () { 10 } sub ARG1 () { 11 } sub ARG2 () { 12 } sub ARG3 () { 13 } sub ARG4 () { 14 } sub ARG5 () { 15 } sub ARG6 () { 16 } sub ARG7 () { 17 } sub ARG8 () { 18 } sub ARG9 () { 19 } sub import { my $package = caller(); no strict 'refs'; *{ $package . '::OBJECT' } = \&OBJECT; *{ $package . '::MACHINE' } = \&MACHINE; *{ $package . '::KERNEL' } = \&KERNEL; *{ $package . '::RUNSTATE' } = \&RUNSTATE; *{ $package . '::EVENT' } = \&EVENT; *{ $package . '::SENDER' } = \&SENDER; *{ $package . '::STATE' } = \&STATE; *{ $package . '::ARG0' } = \&ARG0; *{ $package . '::ARG1' } = \&ARG1; *{ $package . '::ARG2' } = \&ARG2; *{ $package . '::ARG3' } = \&ARG3; *{ $package . '::ARG4' } = \&ARG4; *{ $package . '::ARG5' } = \&ARG5; *{ $package . '::ARG6' } = \&ARG6; *{ $package . '::ARG7' } = \&ARG7; *{ $package . '::ARG8' } = \&ARG8; *{ $package . '::ARG9' } = \&ARG9; } #------------------------------------------------------------------------------ # Spawn a new state machine. sub _add_ref_states { my ($states, $refs) = @_; foreach my $state (keys %$refs) { $states->{$state} = {}; my $data = $refs->{$state}; croak "the data for state '$state' should be an array" unless ( ref $data eq 'ARRAY' ); croak "the array for state '$state' has an odd number of elements" if ( @$data & 1 ); while (my ($ref, $events) = splice(@$data, 0, 2)) { if (ref $events eq 'ARRAY') { foreach my $event (@$events) { $states->{$state}->{$event} = [ $ref, $event ]; } } elsif (ref $events eq 'HASH') { foreach my $event (keys %$events) { my $method = $events->{$event}; $states->{$state}->{$event} = [ $ref, $method ]; } } else { croak "events with '$ref' for state '$state' " . "need to be a hash or array ref"; } } } } sub spawn { my ($type, @params) = @_; my @args; # We treat the parameter list strictly as a hash. Rather than dying # here with a Perl error, we'll catch it and blame it on the user. croak "odd number of events/handlers (missing one or the other?)" if @params & 1; my %params = @params; croak "$type requires a working Kernel" unless defined $POE::Kernel::poe_kernel; # Options are optional. my $options = delete $params{+SPAWN_OPTIONS}; $options = { } unless defined $options; # States are required. croak( "$type constructor requires at least one of the following parameters: " . join (", ", SPAWN_INLINES, SPAWN_OBJECTS, SPAWN_PACKAGES) ) unless ( exists $params{+SPAWN_INLINES} or exists $params{+SPAWN_OBJECTS} or exists $params{+SPAWN_PACKAGES} ); my $states = delete($params{+SPAWN_INLINES}) || {}; if (exists $params{+SPAWN_OBJECTS}) { my $objects = delete $params{+SPAWN_OBJECTS}; _add_ref_states($states, $objects); } if (exists $params{+SPAWN_PACKAGES}) { my $packages = delete $params{+SPAWN_PACKAGES}; _add_ref_states($states, $packages); } my $runstate = delete($params{+SPAWN_RUNSTATE}) || {}; # These are unknown. croak( "$type constructor does not recognize these parameter names: ", join(', ', sort(keys(%params))) ) if keys %params; # Build me. my $self = bless [ $runstate, # SELF_RUNSTATE $options, # SELF_OPTIONS $states, # SELF_STATES undef, # SELF_ID undef, # SELF_CURRENT [ ], # SELF_STATE_STACK { }, # SELF_INTERNALS '(undef)', # SELF_CURRENT_NAME 0, # SELF_IS_IN_INTERNAL ], $type; # Register the machine with the POE kernel. $POE::Kernel::poe_kernel->session_alloc($self); # Return it for immediate reuse. return $self; } #------------------------------------------------------------------------------ # Another good inheritance candidate. sub DESTROY { my $self = shift; # NFA's data structures are destroyed through Perl's usual garbage # collection. TRACE_DESTROY here just shows what's in the session # before the destruction finishes. TRACE_DESTROY and do { POE::Kernel::_warn( "----- NFA $self Leak Check -----\n", "-- Namespace (HEAP):\n" ); foreach (sort keys (%{$self->[SELF_RUNSTATE]})) { POE::Kernel::_warn(" $_ = ", $self->[SELF_RUNSTATE]->{$_}, "\n"); } POE::Kernel::_warn("-- Options:\n"); foreach (sort keys (%{$self->[SELF_OPTIONS]})) { POE::Kernel::_warn(" $_ = ", $self->[SELF_OPTIONS]->{$_}, "\n"); } POE::Kernel::_warn("-- States:\n"); foreach (sort keys (%{$self->[SELF_STATES]})) { POE::Kernel::_warn(" $_ = ", $self->[SELF_STATES]->{$_}, "\n"); } }; } #------------------------------------------------------------------------------ sub _invoke_state { my ($self, $sender, $event, $args, $file, $line, $fromstate) = @_; # Trace the state invocation if tracing is enabled. if ($self->[SELF_OPTIONS]->{+OPT_TRACE}) { POE::Kernel::_warn( $POE::Kernel::poe_kernel->ID_session_to_id($self), " -> $event\n" ); } # Discard troublesome things. return if $event eq EN_START; return if $event eq EN_STOP; # Stop request has come through the queue. Shut us down. if ($event eq NFA_EN_STOP) { $POE::Kernel::poe_kernel->_data_ses_stop($self->ID); return; } # Make a state transition. if ($event eq NFA_EN_GOTO_STATE) { my ($new_state, $enter_event, @enter_args) = @$args; # Make sure the new state exists. POE::Kernel::_die( $POE::Kernel::poe_kernel->ID_session_to_id($self), " tried to enter nonexistent state '$new_state'\n" ) unless exists $self->[SELF_STATES]->{$new_state}; # If an enter event was specified, make sure that exists too. POE::Kernel::_die( $POE::Kernel::poe_kernel->ID_session_to_id($self), " tried to invoke nonexistent enter event '$enter_event' ", "in state '$new_state'\n" ) unless ( not defined $enter_event or ( length $enter_event and exists $self->[SELF_STATES]->{$new_state}->{$enter_event} ) ); # Invoke the current state's leave event, if one exists. $self->_invoke_state( $self, 'leave', [], undef, undef, undef ) if exists $self->[SELF_CURRENT]->{leave}; # Enter the new state. $self->[SELF_CURRENT] = $self->[SELF_STATES]->{$new_state}; $self->[SELF_CURRENT_NAME] = $new_state; # Invoke the new state's enter event, if requested. $self->_invoke_state( $self, $enter_event, \@enter_args, undef, undef, undef ) if defined $enter_event; return undef; } # Push a state transition. if ($event eq NFA_EN_PUSH_STATE) { my @args = @$args; push( @{$self->[SELF_STATE_STACK]}, [ $self->[SELF_CURRENT_NAME], # STACK_STATE shift(@args), # STACK_EVENT ] ); $self->_invoke_state( $self, NFA_EN_GOTO_STATE, \@args, undef, undef, undef ); return undef; } # Pop a state transition. if ($event eq NFA_EN_POP_STATE) { POE::Kernel::_die( $POE::Kernel::poe_kernel->ID_session_to_id($self), " tried to pop a state from an empty stack\n" ) unless @{ $self->[SELF_STATE_STACK] }; my ($previous_state, $previous_event) = @{ pop @{ $self->[SELF_STATE_STACK] } }; $self->_invoke_state( $self, NFA_EN_GOTO_STATE, [ $previous_state, $previous_event, @$args ], undef, undef, undef ); return undef; } # Stop. # Try to find the event handler in the current state or the internal # event handlers used by wheels and the like. my ( $handler, $is_in_internal ); if (exists $self->[SELF_CURRENT]->{$event}) { $handler = $self->[SELF_CURRENT]->{$event}; } elsif (exists $self->[SELF_INTERNALS]->{$event}) { $handler = $self->[SELF_INTERNALS]->{$event}; $is_in_internal = ++$self->[SELF_IS_IN_INTERNAL]; } # If it wasn't found in either of those, then check for _default in # the current state. elsif (exists $self->[SELF_CURRENT]->{+EN_DEFAULT}) { # If we get this far, then there's a _default event to redirect # the event to. Trace the redirection. if ($self->[SELF_OPTIONS]->{+OPT_TRACE}) { POE::Kernel::_warn( $POE::Kernel::poe_kernel->ID_session_to_id($self), " -> $event redirected to EN_DEFAULT in state ", "'$self->[SELF_CURRENT_NAME]'\n" ); } $handler = $self->[SELF_CURRENT]->{+EN_DEFAULT}; # Transform the parameters for _default. ARG1 and beyond are # copied so they can't be altered at a distance. $args = [ $event, [@$args] ]; $event = EN_DEFAULT; } # No external event handler, no internal event handler, and no # external _default handler. This is a grievous error, and now we # must die. elsif ($event ne EN_SIGNAL) { POE::Kernel::_die( "a '$event' event was sent from $file at $line to session ", $POE::Kernel::poe_kernel->ID_session_to_id($self), ", but session ", $POE::Kernel::poe_kernel->ID_session_to_id($self), " has neither a handler for it nor one for _default ", "in its current state, '$self->[SELF_CURRENT_NAME]'\n" ); } # Inline event handlers are invoked this way. my $return; if (ref($handler) eq 'CODE') { $return = $handler->( undef, # OBJECT $self, # MACHINE $POE::Kernel::poe_kernel, # KERNEL $self->[SELF_RUNSTATE], # RUNSTATE $event, # EVENT $sender, # SENDER $self->[SELF_CURRENT_NAME], # STATE $file, # CALLER_FILE_NAME $line, # CALLER_FILE_LINE $fromstate, # CALLER_STATE @$args # ARG0.. ); } # Package and object handlers are invoked this way. else { my ($object, $method) = @$handler; $return = $object->$method( # OBJECT (package, implied) $self, # MACHINE $POE::Kernel::poe_kernel, # KERNEL $self->[SELF_RUNSTATE], # RUNSTATE $event, # EVENT $sender, # SENDER $self->[SELF_CURRENT_NAME], # STATE $file, # CALLER_FILE_NAME $line, # CALLER_FILE_LINE $fromstate, # CALLER_STATE @$args # ARG0.. ); } $self->[SELF_IS_IN_INTERNAL]-- if $is_in_internal; return $return; } #------------------------------------------------------------------------------ # Add, remove or replace event handlers in the session. This is going # to be tricky since wheels need this but the event handlers can't be # limited to a single state. I think they'll go in a hidden internal # state, or something. sub _register_state { my ($self, $name, $handler, $method) = @_; $method = $name unless defined $method; # Deprecate _signal. if ($name eq EN_SIGNAL) { # Report the problem outside POE. my $caller_level = 0; local $Carp::CarpLevel = 1; while ( (caller $caller_level)[0] =~ /^POE::/ ) { $caller_level++; $Carp::CarpLevel++; } croak( ",----- DEPRECATION ERROR -----\n", "| The _signal event is deprecated. Please use sig() to register\n", "| an explicit signal handler instead.\n", "`-----------------------------\n", ); } # There is a handler, so try to define the state. This replaces an # existing state. if ($handler) { # Coderef handlers are inline states. if (ref($handler) eq 'CODE') { POE::Kernel::_carp( "redefining handler for event($name) for session(", $POE::Kernel::poe_kernel->ID_session_to_id($self), ")" ) if ( $self->[SELF_OPTIONS]->{+OPT_DEBUG} and (exists $self->[SELF_INTERNALS]->{$name}) ); $self->[SELF_INTERNALS]->{$name} = $handler; } # Non-coderef handlers may be package or object states. See if # the method belongs to the handler. elsif ($handler->can($method)) { POE::Kernel::_carp( "redefining handler for event($name) for session(", $POE::Kernel::poe_kernel->ID_session_to_id($self), ")" ) if ( $self->[SELF_OPTIONS]->{+OPT_DEBUG} && (exists $self->[SELF_INTERNALS]->{$name}) ); $self->[SELF_INTERNALS]->{$name} = [ $handler, $method ]; } # Something's wrong. This code also seems wrong, since # ref($handler) can't be 'CODE'. else { if ( (ref($handler) eq 'CODE') and $self->[SELF_OPTIONS]->{+OPT_TRACE} ) { POE::Kernel::_carp( $self->fetch_id(), " : handler for event($name) is not a proper ref - not registered" ) } else { unless ($handler->can($method)) { if (length ref($handler)) { croak "object $handler does not have a '$method' method" } else { croak "package $handler does not have a '$method' method"; } } } } } # No handler. Delete the state! else { delete $self->[SELF_INTERNALS]->{$name}; } } #------------------------------------------------------------------------------ # Return the session's ID. This is a thunk into POE::Kernel, where # the session ID really lies. This is a good inheritance candidate. sub _set_id { my ($self, $id) = @_; $self->[SELF_ID] = $id; } sub ID { return shift()->[SELF_ID]; } #------------------------------------------------------------------------------ # Return the session's current state's name. sub get_current_state { my $self = shift; return $self->[SELF_CURRENT_NAME]; } #------------------------------------------------------------------------------ # Fetch the session's run state. In rare cases, libraries may need to # break encapsulation this way, probably also using # $kernel->get_current_session as an accessory to the crime. sub get_runstate { my $self = shift; return $self->[SELF_RUNSTATE]; } #------------------------------------------------------------------------------ # Set or fetch session options. This is virtually identical to # POE::Session and a good inheritance candidate. sub option { my $self = shift; my %return_values; # Options are set in pairs. while (@_ >= 2) { my ($flag, $value) = splice(@_, 0, 2); $flag = lc($flag); # If the value is defined, then set the option. if (defined $value) { # Change some handy values into boolean representations. This # clobbers the user's original values for the sake of DWIM-ism. ($value = 1) if ($value =~ /^(on|yes|true)$/i); ($value = 0) if ($value =~ /^(no|off|false)$/i); $return_values{$flag} = $self->[SELF_OPTIONS]->{$flag}; $self->[SELF_OPTIONS]->{$flag} = $value; } # Remove the option if the value is undefined. else { $return_values{$flag} = delete $self->[SELF_OPTIONS]->{$flag}; } } # If only one option is left, then there's no value to set, so we # fetch its value. if (@_) { my $flag = lc(shift); $return_values{$flag} = ( exists($self->[SELF_OPTIONS]->{$flag}) ? $self->[SELF_OPTIONS]->{$flag} : undef ); } # If only one option was set or fetched, then return it as a scalar. # Otherwise return it as a hash of option names and values. my @return_keys = keys(%return_values); if (@return_keys == 1) { return $return_values{$return_keys[0]}; } else { return \%return_values; } } #------------------------------------------------------------------------------ # This stuff is identical to the stuff in POE::Session. Good # inheritance candidate. # Create an anonymous sub that, when called, posts an event back to a # session. This is highly experimental code to support Tk widgets and # maybe Event callbacks. There's no guarantee that this code works # yet, nor is there one that it'll be here in the next version. # This maps postback references (stringified; blessing, and thus # refcount, removed) to parent session IDs. Members are set when # postbacks are created, and postbacks' DESTROY methods use it to # perform the necessary cleanup when they go away. Thanks to njt for # steering me right on this one. my %postback_parent_id; # I assume that when the postback owner loses all reference to it, # they are done posting things back to us. That's when the postback's # DESTROY is triggered, and referential integrity is maintained. sub POE::NFA::Postback::DESTROY { my $self = shift; my $parent_id = delete $postback_parent_id{$self}; $POE::Kernel::poe_kernel->refcount_decrement( $parent_id, 'postback' ); } # Tune postbacks depending on variations in toolkit behavior. BEGIN { # Tk blesses its callbacks internally, so we need to wrap our # blessed callbacks in unblessed ones. Otherwise our postback's # DESTROY method probably won't be called. if (exists $INC{'Tk.pm'}) { eval 'sub USING_TK () { 1 }'; } else { eval 'sub USING_TK () { 0 }'; } }; # Create a postback closure, maintaining referential integrity in the # process. The next step is to give it to something that expects to # be handed a callback. sub postback { my ($self, $event, @etc) = @_; my $id = $POE::Kernel::poe_kernel->ID_session_to_id(shift); my $postback = bless sub { $POE::Kernel::poe_kernel->post( $id, $event, [ @etc ], [ @_ ] ); return 0; }, 'POE::NFA::Postback'; $postback_parent_id{$postback} = $id; $POE::Kernel::poe_kernel->refcount_increment( $id, 'postback' ); # Tk blesses its callbacks, so we must present one that isn't # blessed. Otherwise Tk's blessing would divert our DESTROY call to # its own, and that's not right. return sub { $postback->(@_) } if USING_TK; return $postback; } # Create a synchronous callback closure. The return value will be # passed to whatever is handed the callback. # # TODO - Should callbacks hold reference counts like postbacks do? sub callback { my ($self, $event, @etc) = @_; my $id = $POE::Kernel::poe_kernel->ID_session_to_id($self); my $callback = sub { return $POE::Kernel::poe_kernel->call( $id, $event, [ @etc ], [ @_ ] ); }; $callback; } #============================================================================== # New methods. sub goto_state { my ($self, $new_state, $entry_event, @entry_args) = @_; if (defined $self->[SELF_CURRENT] && !$self->[SELF_OPTIONS]->{+OPT_IMMEDIATE}) { $POE::Kernel::poe_kernel->post( $self, NFA_EN_GOTO_STATE, $new_state, $entry_event, @entry_args ); } else { $POE::Kernel::poe_kernel->call( $self, NFA_EN_GOTO_STATE, $new_state, $entry_event, @entry_args ); } } sub stop { my $self = shift; $POE::Kernel::poe_kernel->post( $self, NFA_EN_STOP ); } sub call_state { my ($self, $return_event, $new_state, $entry_event, @entry_args) = @_; if ($self->[SELF_OPTIONS]->{+OPT_IMMEDIATE}) { $POE::Kernel::poe_kernel->call( $self, NFA_EN_PUSH_STATE, $return_event, $new_state, $entry_event, @entry_args ); } else { $POE::Kernel::poe_kernel->post( $self, NFA_EN_PUSH_STATE, $return_event, $new_state, $entry_event, @entry_args ); } } sub return_state { my ($self, @entry_args) = @_; if ($self->[SELF_OPTIONS]->{+OPT_IMMEDIATE}) { $POE::Kernel::poe_kernel->call( $self, NFA_EN_POP_STATE, @entry_args ); } else { $POE::Kernel::poe_kernel->post( $self, NFA_EN_POP_STATE, @entry_args ); } } 1; __END__ =head1 NAME POE::NFA - an event-driven state machine (nondeterministic finite automaton) =head1 SYNOPSIS use POE::Kernel; use POE::NFA; use POE::Wheel::ReadLine; # Spawn an NFA and enter its initial state. POE::NFA->spawn( inline_states => { initial => { setup => \&setup_stuff, }, state_login => { on_entry => \&login_prompt, on_input => \&save_login, }, state_password => { on_entry => \&password_prompt, on_input => \&check_password, }, state_cmd => { on_entry => \&command_prompt, on_input => \&handle_command, }, }, )->goto_state(initial => "setup"); POE::Kernel->run(); exit; sub setup_stuff { $_[RUNSTATE]{io} = POE::Wheel::ReadLine->new( InputEvent => 'on_input', ); $_[MACHINE]->goto_state(state_login => "on_entry"); } sub login_prompt { $_[RUNSTATE]{io}->get('Login: '); } sub save_login { $_[RUNSTATE]{login} = $_[ARG0]; $_[MACHINE]->goto_state(state_password => "on_entry"); } sub password_prompt { $_[RUNSTATE]{io}->get('Password: '); } sub check_password { if ($_[RUNSTATE]{login} eq $_[ARG0]) { $_[MACHINE]->goto_state(state_cmd => "on_entry"); } else { $_[MACHINE]->goto_state(state_login => "on_entry"); } } sub command_prompt { $_[RUNSTATE]{io}->get('Cmd: '); } sub handle_command { $_[RUNSTATE]{io}->put(" <<$_[ARG0]>>"); if ($_[ARG0] =~ /^(?:quit|stop|exit|halt|bye)$/i) { $_[RUNSTATE]{io}->put('Bye!'); $_[MACHINE]->stop(); } else { $_[MACHINE]->goto_state(state_cmd => "on_entry"); } } =head1 DESCRIPTION POE::NFA implements a different kind of POE session: A non-deterministic finite automaton. Let's break that down. A finite automaton is a state machine with a bounded number of states and transitions. Technically, POE::NFA objects may modify themselves at run time, so they aren't really "finite". Run-time modification isn't currently supported by the API, so plausible deniability is maintained! Deterministic state machines are ones where all possible transitions are known at compile time. POE::NFA is "non-deterministic" because transitions may change based on run-time conditions. But more simply, POE::NFA is like POE::Session but with banks of event handlers that may be swapped according to the session's run-time state. Consider the SYNOPSIS example, which has "on_entry" and "on_input" handlers that do different things depending on the run-time state. POE::Wheel::ReadLine throws "on_input", but different things happen depending whether the session is in its "login", "password" or "command" state. POE::NFA borrows heavily from POE::Session, so this document will only discuss the differences. Please see L for things which are similar. =head1 PUBLIC METHODS This document mainly focuses on the differences from POE::Session. =head2 get_current_state Each machine state has a name. get_current_state() returns the name of the machine's current state. get_current_state() is mainly used to retrieve the state of some other machine. It's easier (and faster) to use C<$_[STATE]> in a machine's own event handlers. =head2 get_runstate get_runstate() returns the machine's current runstate. Runstates are equivalent to POE::Session HEAPs, so this method does pretty much the same as POE::Session's get_heap(). It's easier (and faster) to use C<$_[RUNSTATE]> in a machine's own event handlers, however. =head2 spawn STATE_NAME => HANDLERS_HASHREF[, ...] spawn() is POE::NFA's constructor. The name reflects the idea that new state machines are spawned like threads or processes rather than instantiated like objects. The machine itself is defined as a list of state names and hashes that map events to handlers within each state. my %states = ( state_1 => { event_1 => \&handler_1, event_2 => \&handler_2, }, state_2 => { event_1 => \&handler_3, event_2 => \&handler_4, }, ); A single event may be handled by many states. The proper handler will be called depending on the machine's current state. For example, if C is dispatched while the machine is in C, then handler_3() will be called to handle the event. The state -> event -> handler map looks like this: $machine{state_2}{event_1} = \&handler_3; Instead of C, C or C may be used. These map the events of a state to an object or package method respectively. object_states => { state_1 => [ $object_1 => [qw(event_1 event_2)], ], state_2 => [ $object_2 => { event_1 => method_1, event_2 => method_2, } ] } In the example above, in the case of C coming in while the machine is in C, method C will be called on $object_1. If the machine is in C, method C will be called on $object_2. C is very similar, but instead of using an $object, you pass in a C The C parameter allows C to be initialized differently at instantiation time. C, like heaps, are usually anonymous hashrefs, but C may set them to be array references or even objects. State transitions are not necessarily executed immediately by default. Rather, they are placed in POEs event queue behind any currently pending events. Enabling the C option causes state transitions to occur immediately, regardless of any queued events. =head2 goto_state NEW_STATE[, ENTRY_EVENT[, EVENT_ARGS]] goto_state() puts the machine into a new state. If an ENTRY_EVENT is specified, then that event will be dispatched after the machine enters the new state. EVENT_ARGS, if included, will be passed to the entry event's handler via C. # Switch to the next state. $_[MACHINE]->goto_state( 'next_state' ); # Switch to the next state, and call a specific entry point. $_[MACHINE]->goto_state( 'next_state', 'entry_event' ); # Switch to the next state; call an entry point with some values. $_[MACHINE]->goto_state( 'next_state', 'entry_event', @parameters ); =head2 stop stop() forces a machine to stop. The machine will also stop gracefully if it runs out of things to do, just like POE::Session. stop() is heavy-handed. It will force resources to be cleaned up. However, circular references in the machine's C are not POE's responsibility and may cause memory leaks. $_[MACHINE]->stop(); =head2 call_state RETURN_EVENT, NEW_STATE[, ENTRY_EVENT[, EVENT_ARGS]] call_state() is similar to goto_state(), but it pushes the current state on a stack. At some later point, a handler can call return_state() to pop the call stack and return the machine to its old state. At that point, a C will be posted to notify the old state of the return. $machine->call_state( 'return_here', 'new_state', 'entry_event' ); As with goto_state(), C is the event that will be emitted once the machine enters its new state. C are parameters passed to the C handler via C. =head2 return_state [RETURN_ARGS] return_state() returns to the most recent state in which call_state() was invoked. If the preceding call_state() included a return event then its handler will be invoked along with some optional C. The C will be passed to the return handler via C. $_[MACHINE]->return_state( 'success', @success_values ); =head2 Methods that match POE::Session The following methods behave identically to the ones in POE::Session. =over 2 =item ID =item option =item postback =item callback =back =head2 About new() and create() POE::NFA's constructor is spawn(), not new() or create(). =head1 PREDEFINED EVENT FIELDS POE::NFA's predefined event fields are the same as POE::Session's with the following three exceptions. =head2 MACHINE C is equivalent to Session's C field. It holds a reference to the current state machine, and is useful for calling its methods. See POE::Session's C field for more information. $_[MACHINE]->goto_state( $next_state, $next_state_entry_event ); =head2 RUNSTATE C is equivalent to Session's C field. It holds an anonymous hash reference which POE is guaranteed not to touch. Data stored in C will persist between handler invocations. =head2 STATE C contains the name of the machine's current state. It is not equivalent to anything from POE::Session. =head2 EVENT C is equivalent to Session's C field. It holds the name of the event which invoked the current handler. See POE::Session's C field for more information. =head1 PREDEFINED EVENT NAMES POE::NFA defines four events of its own. These events are used internally and may not be overridden by application code. See POE::Session's "PREDEFINED EVENT NAMES" section for more information about other predefined events. The events are: C, C, C, C. Yes, all the internal events begin with "poe_nfa_". More may be forthcoming, but they will always begin the same way. Therefore please do not define events beginning with "poe_nfa_". =head1 SEE ALSO Many of POE::NFA's features are taken directly from POE::Session. Please see L for more information. The SEE ALSO section in L contains a table of contents covering the entire POE distribution. =head1 BUGS See POE::Session's documentation. POE::NFA is not as feature-complete as POE::Session. Your feedback is appreciated. =head1 AUTHORS & COPYRIGHTS Please see L for more information about authors and contributors. =cut # rocco // vim: ts=2 sw=2 expandtab # TODO - Edit. POE-1.370/lib/POE/Filter.pm000644 001751 001751 00000025207 14216606677 015756 0ustar00bingosbingos000000 000000 package POE::Filter; use strict; use vars qw($VERSION); $VERSION = '1.370'; # NOTE - Should be #.### (three decimal places) use Carp qw(croak); #------------------------------------------------------------------------------ sub new { my $type = shift; croak "$type is not meant to be used directly"; } # Return all the messages possible to parse in the current input # buffer. This uses the newer get_one_start() and get_one(), which is # implementation dependent. sub get { my ($self, $stream) = @_; my @return; $self->get_one_start($stream); while (1) { my $next = $self->get_one(); last unless @$next; push @return, @$next; } return \@return; } sub clone { my $self = shift; my $buf = (ref($self->[0]) eq 'ARRAY') ? [ ] : ''; my $nself = bless [ $buf, # BUFFER @$self[1..$#$self], # everything else ], ref $self; return $nself; } sub __param_max { my( $type, $name, $default, $params ) = @_; return $default # 512 MB unless defined $params->{$name}; my $ret = $params->{$name}; croak "$name must be a number" unless $ret =~ /^\d+$/; croak "$name must greater then 0" unless $ret > 0; return $ret; } 1; __END__ =head1 NAME POE::Filter - protocol abstractions for POE::Wheel and standalone use =head1 SYNOPSIS To use with POE::Wheel classes, pass a POE::Filter object to one of the "...Filter" constructor parameters: #!perl use POE qw(Filter::Line Wheel::FollowTail); POE::Session->create( inline_states => { _start => sub { $_[HEAP]{tailor} = POE::Wheel::FollowTail->new( Filename => "/var/log/system.log", InputEvent => "got_log_line", Filter => POE::Filter::Line->new(), ); }, got_log_line => sub { print "Log: $_[ARG0]\n"; } } ); POE::Kernel->run(); exit; Standalone use without POE: #!perl use warnings; use strict; use POE::Filter::Line; my $filter = POE::Filter::Line->new( Literal => "\n" ); # Prints three lines: one, two three. $filter->get_one_start(["one\ntwo\nthr", "ee\nfour"]); while (1) { my $line = $filter->get_one(); last unless @$line; print $line->[0], "\n"; } # Prints two lines: four, five. $filter->get_one_start(["\nfive\n"]); while (1) { my $line = $filter->get_one(); last unless @$line; print $line->[0], "\n"; } =head1 DESCRIPTION POE::Filter objects plug into the wheels and define how the data will be serialized for writing and parsed after reading. POE::Wheel objects are responsible for moving data, and POE::Filter objects define how the data should look. POE::Filter objects are simple by design. They do not use POE internally, so they are limited to serialization and parsing. This may complicate implementation of certain protocols (like HTTP 1.x), but it allows filters to be used in stand-alone programs. Stand-alone use is very important. It allows application developers to create lightweight blocking libraries that may be used as simple clients for POE servers. POE::Component::IKC::ClientLite is a notable example. This lightweight, blocking event-passing client supports thin clients for gridded POE applications. The canonical use case is to inject events into an IKC application or grid from CGI interfaces, which require lightweight resource use. POE filters and drivers pass data in array references. This is slightly awkward, but it minimizes the amount of data that must be copied on Perl's stack. =head1 PUBLIC INTERFACE All POE::Filter classes must support the minimal interface, defined here. Specific filters may implement and document additional methods. =head2 new PARAMETERS new() creates and initializes a new filter. Constructor parameters vary from one POE::Filter subclass to the next, so please consult the documentation for your desired filter. =head2 clone clone() creates and initializes a new filter based on the constructor parameters of the existing one. The new filter is a near-identical copy, except that its buffers are empty. Certain components, such as POE::Component::Server::TCP, use clone(). These components accept a master or template filter at creation time, then clone() that filter for each new connection. my $new_filter = $old_filter->clone(); =head2 get_one_start ARRAYREF get_one_start() accepts an array reference containing unprocessed stream chunks. The chunks are added to the filter's internal buffer for parsing by get_one(). The L shows get_one_start() in use. =head2 get_one get_one() parses zero or one complete item from the filter's internal buffer. The data is returned as an ARRAYREF suitable for passing to another filter or a POE::Wheel object. Filters will return empty ARRAYREFs if they don't have enough raw data to build a complete item. get_one() is the lazy form of get(). It only parses only one item at a time from the filter's buffer. This is vital for applications that may switch filters in mid-stream, as it ensures that the right filter is in use at any given time. The L shows get_one() in use. Note how it assumes the return is always an ARRAYREF, and it implicitly handles empty ones. =head2 get ARRAYREF get() is the greedy form of get_one(). It accepts an array reference containing unprocessed stream chunks, and it adds that data to the filter's internal buffer. It then parses as many full items as possible from the buffer and returns them in another array reference. Any unprocessed data remains in the filter's buffer for the next call. As with get_one(), get() will return an empty array reference if the filter doesn't contain enough raw data to build a complete item. In fact, get() is implemented in POE::Filter in terms of get_one_start() and get_one(). Here's the get() form of the SYNOPSIS stand-alone example: #!perl use warnings; use strict; use POE::Filter::Line; my $filter = POE::Filter::Line->new( Literal => "\n" ); # Prints three lines: one, two three. my $lines = $filter->get(["one\ntwo\nthr", "ee\nfour"]); foreach my $line (@$lines) { print "$line\n"; } # Prints two lines: four, five. $lines = $filter->get(["\nfive\n"]); foreach my $line (@$lines) { print "$line\n"; } get() should not be used with wheels that support filter switching. Its greedy nature means that it often parses streams well in advance of a wheel's events. By the time an application changes the wheel's filter, it's too late: The old filter has already parsed the rest of the received data. Consider a stream of letters, numbers, and periods. The periods signal when to switch filters from one that parses letters to one that parses numbers. In our hypothetical application, letters must be handled one at a time, but numbers may be handled in chunks. We'll use POE::Filter::Block with a BlockSize of 1 to parse letters, and POE::FIlter::Line with a Literal terminator of "." to handle numbers. Here's the sample stream: abcdefg.1234567.hijklmnop.890.q We'll start with a ReadWrite wheel configured to parse characters. $_[HEAP]{wheel} = POE::Wheel::ReadWrite->new( Filter => POE::Filter::Block->new( BlockSize => 1 ), Handle => $socket, InputEvent => "got_letter", ); The "got_letter" handler will be called 8 times. One for each letter from a through g, and once for the period following g. Upon receiving the period, it will switch the wheel into number mode. sub handle_letter { my $letter = $_[ARG0]; if ($letter eq ".") { $_[HEAP]{wheel}->set_filter( POE::Filter::Line->new( Literal => "." ) ); $_[HEAP]{wheel}->event( InputEvent => "got_number" ); } else { print "Got letter: $letter\n"; } } If the greedy get() were used, the entire input stream would have been parsed as characters in advance of the first handle_letter() call. The set_filter() call would have been moot, since there would be no data left to be parsed. The "got_number" handler receives contiguous runs of digits as period-terminated lines. The greedy get() would cause a similar problem as above. sub handle_numbers { my $numbers = $_[ARG0]; print "Got number(s): $numbers\n"; $_[HEAP]->{wheel}->set_filter( POE::Filter::Block->new( BlockSize => 1 ) ); $_[HEAP]->{wheel}->event( InputEvent => "got_letter" ); } So don't do it! =head2 put ARRAYREF put() serializes items into a stream of octets that may be written to a file or sent across a socket. It accepts a reference to a list of items, and it returns a reference to a list of marshalled stream chunks. The number of output chunks is not necessarily related to the number of input items. In stand-alone use, put()'s output may be sent directly: my $line_filter = POE::Filter::Line->new(); my $lines = $line_filter->put(\@list_of_things); foreach my $line (@$lines) { print $line; } The list reference it returns may be passed directly to a driver or filter. Drivers and filters deliberately share the same put() interface so that things like this are possible: $driver->put( $transfer_encoding_filter->put( $content_encoding_filter->put( \@items ) ) ); 1 while $driver->flush(\*STDOUT); =head2 get_pending get_pending() returns any data remaining in a filter's input buffer. The filter's input buffer is not cleared, however. get_pending() returns a list reference if there's any data, or undef if the filter was empty. POE::Wheel objects use get_pending() during filter switching. Unprocessed data is fetched from the old filter with get_pending() and injected into the new filter with get_one_start(). use POE::Filter::Line; use POE::Filter::Stream; my $line_filter = POE::Filter::Line->new(); $line_filter->get_one_start([ "not a complete line" ]); my $stream_filter = POE::Filter::Stream->new(); my $line_buffer = $line_filter->get_pending(); $stream_filter->get_one_start($line_buffer) if $line_buffer; print "Stream: $_\n" foreach (@{ $stream_filter->get_one }); Full items are serialized whole, so there is no corresponding "put" buffer or accessor. =head1 SEE ALSO The SEE ALSO section in L contains a table of contents covering the entire POE distribution. POE is bundled with the following filters: L L L L L L L L L =head1 BUGS In theory, filters should be interchangeable. In practice, stream and block protocols tend to be incompatible. =head1 AUTHORS & COPYRIGHTS Please see L for more information about authors and contributors. =cut # rocco // vim: ts=2 sw=2 expandtab # TODO - Edit. POE-1.370/lib/POE/Queue/000755 001751 001751 00000000000 14216613074 015236 5ustar00bingosbingos000000 000000 POE-1.370/lib/POE/Component/000755 001751 001751 00000000000 14216613074 016114 5ustar00bingosbingos000000 000000 POE-1.370/lib/POE/Wheel/000755 001751 001751 00000000000 14216613074 015216 5ustar00bingosbingos000000 000000 POE-1.370/lib/POE/Loop.pm000644 001751 001751 00000043711 14216606677 015442 0ustar00bingosbingos000000 000000 package POE::Loop; use strict; use vars qw($VERSION); $VERSION = '1.370'; # NOTE - Should be #.### (three decimal places) 1; __END__ =head1 NAME POE::Loop - documentation for POE's event loop bridge interface =head1 SYNOPSIS $kernel->loop_initialize(); $kernel->loop_finalize(); $kernel->loop_do_timeslice(); $kernel->loop_run(); $kernel->loop_halt(); $kernel->loop_watch_signal($signal_name); $kernel->loop_ignore_signal($signal_name); $kernel->loop_attach_uidestroy($gui_window); $kernel->loop_resume_time_watcher($next_time); $kernel->loop_reset_time_watcher($next_time); $kernel->loop_pause_time_watcher(); $kernel->loop_watch_filehandle($handle, $mode); $kernel->loop_ignore_filehandle($handle, $mode); $kernel->loop_pause_filehandle($handle, $mode); $kernel->loop_resume_filehandle($handle, $mode); =head1 DESCRIPTION POE::Loop is a virtual base class that defines a standard event loop interface. POE::Loop subclasses mix into POE::Kernel and implement the features needed to manage underlying event loops in a consistent fashion. This documentation covers the interface, which is shared by all subclasses. As POE::Kernel loads, it searches through %INC for event loop modules. POE::Kernel loads the most appropriate POE::Loop subclass for the event loop it finds. The subclass slots its methods into POE::Kernel, completing the class at load time. POE and POE::Kernel provide ways to state the desired event loop in case the auto-detection makes a mistake or the developer prefers to be explicit. See L for instructions on how to actually use POE with other event loops, event loop naming conventions, and other details. POE::Loop subclasses exist for many of the event loops Perl supports: select(), IO::Poll, WxWindows, EV, Glib, Event, and so on. See CPAN for a full list. =head1 GENERAL NOTES As previously noted, POE::Loop subclasses provide additional methods to POE::Kernel and are not proper objects in themselves. Each POE::Loop subclass first defines its own namespace and version within it. This way CPAN and other things can track its version. They then switch to the POE::Kernel package to define their additional methods. POE::Loop is designed as a mix-in class because Perl imposed a performance penalty for method inheritance at the time the class was designed. This could be changed in the future, but it will require cascaded changes in several other classes. Here is a skeleton of a POE::Loop subclass: use strict; # YourToolkit bridge for POE::Kernel; package POE::Loop::YourToolkit; use vars qw($VERSION); $VERSION = '1.000'; # NOTE - Should be #.### (three decimal places) package POE::Kernel; # Define private lexical data here. # Implement the POE::Loop interface here. 1; __END__ =head1 NAME ... documentation goes here ... =cut =head1 PUBLIC INTERFACE POE::Loop's public interface is divided into four parts: administrative methods, signal handler methods, time management methods, and filehandle watcher methods. Each group and its members will be described in detail shortly. POE::Loop subclasses use lexical variables to keep track of things. Exact implementation is left up to the subclass' author. POE::Loop::Select keeps its bit vectors for select() calls in class-scoped (static) lexical variables. POE::Loop::Gtk tracks a single time watcher and multiple file watchers there. Bridges often employ private methods as callbacks from their event loops. The Event, Gtk, and Tk bridges do this. Private callback names should begin with "_loop_" to avoid colliding with other methods. Developers should look at existing bridges to get a feel for things. The C<-m> flag for perldoc will show a module in its entirety. perldoc -m POE::Loop::Select perldoc -m POE::Loop::Gtk ... =head2 Administrative Methods These methods initialize and finalize an event loop, run the loop to process events, and halt it. =head3 loop_initialize Initialize the event loop. Graphical toolkits especially need some sort of init() call or sequence to set up. For example, Tk requires a widget to be created before any events will be processed, and the program's user interface will be considered destroyed if that widget is closed. sub loop_initialize { my $self = shift; $poe_main_window = Tk::MainWindow->new(); die "could not create a main Tk window" unless defined $poe_main_window; $self->signal_ui_destroy($poe_main_window); } POE::Loop::Select initializes its select() bit vectors. sub loop_initialize { @loop_vectors = ( '', '', '' ); vec($loop_vectors[MODE_RD], 0, 1) = 0; vec($loop_vectors[MODE_WR], 0, 1) = 0; vec($loop_vectors[MODE_EX], 0, 1) = 0; } =head3 loop_finalize Finalize the event loop. Most event loops do not require anything here since they have already stopped by the time loop_finalize() is called. However, this is a good place to check that a bridge has not leaked memory or data. This example comes from POE::Loop::Event. sub loop_finalize { my $self = shift; foreach my $fd (0..$#fileno_watcher) { next unless defined $fileno_watcher[$fd]; foreach my $mode (MODE_RD, MODE_WR, MODE_EX) { POE::Kernel::_warn( "Mode $mode watcher for fileno $fd is defined during loop finalize" ) if defined $fileno_watcher[$fd]->[$mode]; } } $self->loop_ignore_all_signals(); } =head3 loop_do_timeslice Wait for time to pass or new events to occur, and dispatch any events that become due. If the underlying event loop does this through callbacks, then loop_do_timeslice() will either provide minimal glue or do nothing. For example, loop_do_timeslice() for POE::Loop::Select sets up and calls select(). If any files or other resources become active, it enqueues events for them. Finally, it triggers dispatch for any events are due. On the other hand, the Gtk event loop handles all this, so loop_do_timeslice() is empty for the Gtk bridge. A sample loop_do_timeslice() implementation is not presented here because it would either be quite large or empty. See each POE::Loop::IO_Poll or Select for large ones. Event and Gtk are empty. The bridges for Poll and Select for large ones. The ones for Event and Gtk are empty, and Tk's (in POE::Loop::TkCommon) is rather small. =head3 loop_run Run an event loop until POE has no more sessions to handle events. This method tends to be quite small, and it is often implemented in terms of loop_do_timeslice(). For example, POE::Loop::IO_Poll implements it: sub loop_run { my $self = shift; while ($self->_data_ses_count()) { $self->loop_do_timeslice(); } } This method is even more trivial when an event loop handles it. This is from the Gtk bridge: sub loop_run { unless (defined $_watcher_timer) { $_watcher_timer = Gtk->idle_add(\&_loop_resume_timer); } Gtk->main; } =head3 loop_halt loop_halt() does what it says: It halts POE's underlying event loop. It tends to be either trivial for external event loops or empty for ones that are implemented in the bridge itself (IO_Poll, Select). For example, the loop_run() method in the Poll bridge exits when sessions have run out, so its loop_halt() method is empty: sub loop_halt { # does nothing } Gtk, however, needs to be stopped because it does not know when POE is done. sub loop_halt { Gtk->main_quit(); } =head2 Signal Management Methods These methods enable and disable signal watchers. They are used by POE::Resource::Signals to manage an event loop's signal watchers. Most event loops use Perl's %SIG to watch for signals. This is so common that POE::Loop::PerlSignals implements the interface on behalf of other subclasses. =head3 loop_watch_signal SIGNAL_NAME Watch for a given SIGNAL_NAME. SIGNAL_NAME is the version found in %SIG, which tends to be the operating signal's name with the leading "SIG" removed. POE::Loop::PerlSignals' implementation adds callbacks to %SIG except for CHLD/CLD, which begins a waitpid() polling loop instead. As of this writing, all of the POE::Loop subclasses register their signal handlers through POE::Loop::PerlSignals. There are three types of signal handlers: CHLD/CLD handlers, when managed by the bridges themselves, poll for exited children. POE::Kernel does most of this, but loop_watch_signal() still needs to start the process. PIPE handlers. The PIPE signal event must be sent to the session that is active when the signal occurred. Everything else. Signal events for everything else are sent to POE::Kernel, where they are distributed to every session. The loop_watch_signal() methods tends to be very long, so an example is not presented here. The Event and Select bridges have good examples, though. =head3 loop_ignore_signal SIGNAL_NAME Stop watching SIGNAL_NAME. POE::Loop::PerlSignals does this by resetting the %SIG for the SIGNAL_NAME to a sane value. $SIG{CHLD} is left alone so as to avoid interfering with system() and other things. SIGPIPE is generally harmless since POE generates events for this condition. Therefore $SIG{PIPE} is set to "IGNORE" when it's not being handled. All other signal handlers default to "DEFAULT" when not in use. =head3 loop_attach_uidestroy WIDGET POE, when used with a graphical toolkit, should shut down when the user interface is closed. loop_attach_uidestroy() is used to shut down POE when a particular WIDGET is destroyed. The shutdown is done by firing a UIDESTROY signal when the WIDGET's closure or destruction callback is invoked. UIDESTROY guarantees the program will shut down by virtue of being terminal and non-maskable. loop_attach_uidestroy() is only meaningful in POE::Loop subclasses that tie into user interfaces. All other subclasses leave the method empty. Here's Gtk's: sub loop_attach_uidestroy { my ($self, $window) = @_; $window->signal_connect( delete_event => sub { if ($self->_data_ses_count()) { $self->_dispatch_event( $self, $self, EN_SIGNAL, ET_SIGNAL, [ 'UIDESTROY' ], __FILE__, __LINE__, undef, monotime(), -__LINE__ ); } return 0; } ); } =head2 Alarm and Time Management Methods These methods enable and disable a time watcher or alarm in the underlying event loop. POE only requires one, which is reused or re-created as necessary. Most event loops trigger callbacks when time has passed. It is the bridge's responsibility to register and unregister a callback as needed. When invoked, the callback should dispatch events that have become due and possibly set up a new callback for the next event to be dispatched. The time management methods may accept NEXT_EVENT_TIME. This is the time the next event will become due, in UNIX epoch time. NEXT_EVENT_TIME is a real number and may have sub-second accuracy. It is the bridge's responsibility to convert this value into something the underlying event loop requires. =head3 loop_resume_time_watcher NEXT_EVENT_TIME Resume an already active time watcher. It is used with loop_pause_time_watcher() to provide less expensive timer toggling for frequent use cases. As mentioned above, NEXT_EVENT_TIME is in UNIX epoch time and may have sub-second accuracy. loop_resume_time_watcher() is used by bridges that set them watchers in the underlying event loop. For example, POE::Loop::Gtk implements it this way: sub loop_resume_time_watcher { my ($self, $next_time) = @_; $next_time -= time(); $next_time *= 1000; $next_time = 0 if $next_time < 0; $_watcher_timer = Gtk->timeout_add( $next_time, \&_loop_event_callback ); } This method is usually empty in bridges that implement their own event loops. =head3 loop_reset_time_watcher NEXT_EVENT_TIME Reset a time watcher, often by stopping or destroying an existing one and creating a new one in its place. It is often a wrapper for loop_resume_time_watcher() that first destroys an existing watcher. For example, POE::Loop::Gkt's implementation: sub loop_reset_time_watcher { my ($self, $next_time) = @_; Gtk->timeout_remove($_watcher_timer); undef $_watcher_timer; $self->loop_resume_time_watcher($next_time); } =head3 loop_pause_time_watcher Pause a time watcher without destroying it, if the underlying event loop supports such a thing. POE::Loop::Event does support it: sub loop_pause_time_watcher { $_watcher_timer or return; $_watcher_timer->stop(); } =head2 File Activity Management Methods These methods enable and disable file activity watchers. There are four methods: loop_watch_filehandle(), loop_ignore_filehandle(), loop_pause_filehandle(), and loop_resume_filehandle(). The "pause" and "resume" methods are lightweight versions of "ignore" and "watch", respectively. All the methods take the same two parameters: a file HANDLE and a file access MODE. Modes may be MODE_RD, MODE_WR, or MODE_EX. These constants are defined by POE::Kernel and correspond to the semantics of POE::Kernel's select_read(), select_write(), and select_expedite() methods. POE calls MODE_EX "expedited" because it often signals that a file is ready for out-of-band information. Not all event loops handle MODE_EX. For example, Tk: sub loop_watch_filehandle { my ($self, $handle, $mode) = @_; my $fileno = fileno($handle); my $tk_mode; if ($mode == MODE_RD) { $tk_mode = 'readable'; } elsif ($mode == MODE_WR) { $tk_mode = 'writable'; } else { # The Tk documentation implies by omission that expedited # filehandles aren't, uh, handled. This is part 1 of 2. confess "Tk does not support expedited filehandles"; } # ... rest omitted .... } =head3 loop_watch_filehandle FILE_HANDLE, IO_MODE Watch a FILE_HANDLE for activity in a given IO_MODE. Depending on the underlying event loop, a watcher or callback will be registered for the FILE_HANDLE. Activity in the specified IO_MODE (read, write, or out of band) will trigger emission of the proper event in application space. POE::Loop::Select sets the fileno()'s bit in the proper select() bit vector. It also keeps track of which file descriptors are active. sub loop_watch_filehandle { my ($self, $handle, $mode) = @_; my $fileno = fileno($handle); vec($loop_vectors[$mode], $fileno, 1) = 1; $loop_filenos{$fileno} |= (1<<$mode); } =head3 loop_ignore_filehandle FILE_HANDLE, IO_MODE Stop watching the FILE_HANDLE in a given IO_MODE. Stops (and possibly destroys) an event watcher corresponding to the FILE_HANDLE and IO_MODE. POE::Loop::IO_Poll's loop_ignore_filehandle() manages descriptor/mode bits for its _poll() method here. It also performs some cleanup if a descriptor is no longer being watched after this ignore call. sub loop_ignore_filehandle { my ($self, $handle, $mode) = @_; my $fileno = fileno($handle); my $type = mode_to_poll($mode); my $current = $poll_fd_masks{$fileno} || 0; my $new = $current & ~$type; if (TRACE_FILES) { POE::Kernel::_warn( sprintf( " Ignore $fileno: " . ": Current mask: 0x%02X - removing 0x%02X = 0x%02X\n", $current, $type, $new ) ); } if ($new) { $poll_fd_masks{$fileno} = $new; } else { delete $poll_fd_masks{$fileno}; } } =head3 loop_pause_filehandle FILE_HANDLE, IO_MODE This is a lightweight form of loop_ignore_filehandle(). It is used along with loop_resume_filehandle() to temporarily toggle a watcher's state for a FILE_HANDLE in a particular IO_MODE. Some event loops, such as Event.pm, support their file watchers being disabled and re-enabled without the need to destroy and re-create the watcher objects. sub loop_pause_filehandle { my ($self, $handle, $mode) = @_; my $fileno = fileno($handle); $fileno_watcher[$fileno]->[$mode]->stop(); } By comparison, Event's loop_ignore_filehandle() method cancels and destroys the watcher object. sub loop_ignore_filehandle { my ($self, $handle, $mode) = @_; my $fileno = fileno($handle); if (defined $fileno_watcher[$fileno]->[$mode]) { $fileno_watcher[$fileno]->[$mode]->cancel(); undef $fileno_watcher[$fileno]->[$mode]; } } Ignoring and re-creating watchers is relatively expensive, so POE::Kernel's select_pause_read() and select_resume_read() methods (and the corresponding ones for write and expedite) use the faster versions. =head3 loop_resume_filehandle FILE_HANDLE, IO_MODE This is a lightweight form of loop_watch_filehandle(). It is used along with loop_pause_filehandle() to temporarily toggle a watcher's state for a FILE_HANDLE in a particular IO_MODE. =head1 HOW POE FINDS EVENT LOOP BRIDGES This is a rehash of L. Firstly, if a POE::Loop subclass is manually loaded before POE::Kernel, then that will be used. End of story. If one isn't, POE::Kernel searches for an external event loop module in %INC. For each module in %INC, corresponding POE::XS::Loop and POE::Loop subclasses are tried. For example, if IO::Poll is loaded, POE::Kernel tries use POE::XS::Loop::IO_Poll; use POE::Loop::IO_Poll; This is relatively expensive, but it ensures that POE::Kernel can find new POE::Loop subclasses without defining them in a central registry. POE::Loop::Select is the fallback event loop. It's loaded if no other event loop can be found in %INC. It can't be repeated often enough that event loops must be loaded before POE::Kernel. Otherwise they will not be present in %INC, and POE::Kernel will not detect them. =head1 SEE ALSO L, L, L, L, L, L. L is POE's event loop tests released as a separate, reusable distribution. POE::Loop authors are encouraged to use the tests for their own distributions. =for comment TODO - Link to CPAN for POE::Loop modules. =head1 BUGS None known. =for comment TODO - Link to POE bug queue. =head1 AUTHORS & LICENSING Please see L for more information about authors, contributors, and POE's licensing. =cut # rocco // vim: ts=2 sw=2 expandtab # TODO - Edit. POE-1.370/lib/POE/Pipe.pm000644 001751 001751 00000003324 14216606677 015422 0ustar00bingosbingos000000 000000 # Deprecation notice: Read the documentation. package POE::Pipe; use warnings; use strict; use vars qw($VERSION); $VERSION = '1.370'; # NOTE - Should be #.### (three decimal places) use IO::Pipely; 1; __END__ =head1 NAME POE::Pipe - Deprecated and replaced with delegates to IO::Pipely. =head1 SYNOPSIS See L. =head1 DESCRIPTION On June 29, 2012, POE::Pipe and its subclasses, POE::Pipe::OneWay and POE::Pipe::TwoWay were released to CPAN as IO::Pipely. The POE::Pipe family of modules remained unchanged in POE's distribution. On August 18, 2013, POE::Pipe and its subclasses were gutted. Their implementations were replaced with delegates to IO::Pipely. All tests pass, although the delegates add slight overhead. The documentation was replaced by this deprecation schedule. A mandatory deprecation warning is scheduled to be released after September 2014. POE will begin using IO::Pipely directly. This documentation will be updated to schedule the next deprecation step. The mandatory warning will become a mandatory error a year or so later. Ideally this will occur in August 2015, but it may be delayed due to POE's release schedule. This documentation will be updated to schedule the final deprecation step. Finally, in August 2016 or later, POE::Pipe and its subclasses will be removed from POE's distribution altogether. Users will have had at least four years to update their code. That seems fair. =head1 SEE ALSO L =head1 AUTHOR & COPYRIGHT The POE::Pipe is copyright 2001-2013 by Rocco Caputo. All rights reserved. POE::Pipe is free software; you may redistribute it and/or modify it under the same terms as Perl itself. =cut # rocco // vim: ts=2 sw=2 expandtab # TODO - Edit. POE-1.370/lib/POE/Loop/000755 001751 001751 00000000000 14216613074 015063 5ustar00bingosbingos000000 000000 POE-1.370/lib/POE/Session.pm000644 001751 001751 00000155346 14216606677 016164 0ustar00bingosbingos000000 000000 package POE::Session; use strict; use vars qw($VERSION); $VERSION = '1.370'; # NOTE - Should be #.### (three decimal places) use Carp qw(carp croak); use Errno; sub SE_NAMESPACE () { 0 } sub SE_OPTIONS () { 1 } sub SE_STATES () { 2 } sub SE_ID () { 3 } sub CREATE_ARGS () { 'args' } sub CREATE_OPTIONS () { 'options' } sub CREATE_INLINES () { 'inline_states' } sub CREATE_PACKAGES () { 'package_states' } sub CREATE_OBJECTS () { 'object_states' } sub CREATE_HEAP () { 'heap' } sub OPT_TRACE () { 'trace' } sub OPT_DEBUG () { 'debug' } sub OPT_DEFAULT () { 'default' } sub EN_START () { '_start' } sub EN_DEFAULT () { '_default' } sub EN_SIGNAL () { '_signal' } #------------------------------------------------------------------------------ # Debugging flags for subsystems. They're done as double evals here # so that someone may define them before using POE::Session (or POE), # and the pre-defined value will take precedence over the defaults # here. # Shorthand for defining an assert constant. sub _define_assert { no strict 'refs'; foreach my $name (@_) { local $^W = 0; next if defined *{"ASSERT_$name"}{CODE}; if (defined *{"POE::Kernel::ASSERT_$name"}{CODE}) { eval( "sub ASSERT_$name () { " . *{"POE::Kernel::ASSERT_$name"}{CODE}->() . "}" ); die if $@; } else { eval "sub ASSERT_$name () { ASSERT_DEFAULT }"; die if $@; } } } # Shorthand for defining a trace constant. sub _define_trace { no strict 'refs'; local $^W = 0; foreach my $name (@_) { next if defined *{"TRACE_$name"}{CODE}; if (defined *{"POE::Kernel::TRACE_$name"}{CODE}) { eval( "sub TRACE_$name () { " . *{"POE::Kernel::TRACE_$name"}{CODE}->() . "}" ); die if $@; } else { eval "sub TRACE_$name () { TRACE_DEFAULT }"; die if $@; } } } BEGIN { # ASSERT_DEFAULT changes the default value for other ASSERT_* # constants. It inherits POE::Kernel's ASSERT_DEFAULT value, if # it's present. unless (defined &ASSERT_DEFAULT) { if (defined &POE::Kernel::ASSERT_DEFAULT) { eval( "sub ASSERT_DEFAULT () { " . &POE::Kernel::ASSERT_DEFAULT . " }" ); } else { eval 'sub ASSERT_DEFAULT () { 0 }'; } }; # TRACE_DEFAULT changes the default value for other TRACE_* # constants. It inherits POE::Kernel's TRACE_DEFAULT value, if # it's present. unless (defined &TRACE_DEFAULT) { if (defined &POE::Kernel::TRACE_DEFAULT) { eval( "sub TRACE_DEFAULT () { " . &POE::Kernel::TRACE_DEFAULT . " }" ); } else { eval 'sub TRACE_DEFAULT () { 0 }'; } }; _define_assert("STATES"); _define_trace("DESTROY"); } #------------------------------------------------------------------------------ # Export constants into calling packages. This is evil; perhaps # EXPORT_OK instead? The parameters NFA has in common with SESSION # (and other sessions) must be kept at the same offsets as each-other. sub OBJECT () { 0 } # TODO - deprecate and replace with SELF sub SESSION () { 1 } sub KERNEL () { 2 } sub HEAP () { 3 } sub STATE () { 4 } # TODO - deprecate and replace with EVENT sub SENDER () { 5 } # NFA keeps its state in 6. unused in session so that args match up. sub CALLER_FILE () { 7 } sub CALLER_LINE () { 8 } sub CALLER_STATE () { 9 } # TODO - deprecate and replace with CALLER_EVENT sub ARG0 () { 10 } sub ARG1 () { 11 } sub ARG2 () { 12 } sub ARG3 () { 13 } sub ARG4 () { 14 } sub ARG5 () { 15 } sub ARG6 () { 16 } sub ARG7 () { 17 } sub ARG8 () { 18 } sub ARG9 () { 19 } sub import { my $package = caller(); no strict 'refs'; *{ $package . '::OBJECT' } = \&OBJECT; *{ $package . '::SESSION' } = \&SESSION; *{ $package . '::KERNEL' } = \&KERNEL; *{ $package . '::HEAP' } = \&HEAP; *{ $package . '::STATE' } = \&STATE; *{ $package . '::SENDER' } = \&SENDER; *{ $package . '::ARG0' } = \&ARG0; *{ $package . '::ARG1' } = \&ARG1; *{ $package . '::ARG2' } = \&ARG2; *{ $package . '::ARG3' } = \&ARG3; *{ $package . '::ARG4' } = \&ARG4; *{ $package . '::ARG5' } = \&ARG5; *{ $package . '::ARG6' } = \&ARG6; *{ $package . '::ARG7' } = \&ARG7; *{ $package . '::ARG8' } = \&ARG8; *{ $package . '::ARG9' } = \&ARG9; *{ $package . '::CALLER_FILE' } = \&CALLER_FILE; *{ $package . '::CALLER_LINE' } = \&CALLER_LINE; *{ $package . '::CALLER_STATE' } = \&CALLER_STATE; } sub instantiate { my $type = shift; croak "$type requires a working Kernel" unless defined $POE::Kernel::poe_kernel; my $self = bless [ { }, # SE_NAMESPACE { }, # SE_OPTIONS { }, # SE_STATES ], $type; if (ASSERT_STATES) { $self->[SE_OPTIONS]->{+OPT_DEFAULT} = 1; } return $self; } sub try_alloc { my ($self, @args) = @_; # Verify that the session has a special start state, otherwise how # do we know what to do? Don't even bother registering the session # if the start state doesn't exist. if (exists $self->[SE_STATES]->{+EN_START}) { $POE::Kernel::poe_kernel->session_alloc($self, @args); } else { carp( "discarding session ", $POE::Kernel::poe_kernel->ID_session_to_id($self), " - no '_start' state" ); $self = undef; } $self; } #------------------------------------------------------------------------------ # New style constructor. This uses less DWIM and more DWIS, and it's # more comfortable for some folks; especially the ones who don't quite # know WTM. sub create { my ($type, @params) = @_; my @args; # We treat the parameter list strictly as a hash. Rather than dying # here with a Perl error, we'll catch it and blame it on the user. if (@params & 1) { croak "odd number of events/handlers (missing one or the other?)"; } my %params = @params; my $self = $type->instantiate(\%params); # Process _start arguments. We try to do the right things with what # we're given. If the arguments are a list reference, map its items # to ARG0..ARGn; otherwise make whatever the heck it is be ARG0. if (exists $params{+CREATE_ARGS}) { if (ref($params{+CREATE_ARGS}) eq 'ARRAY') { push @args, @{$params{+CREATE_ARGS}}; } else { push @args, $params{+CREATE_ARGS}; } delete $params{+CREATE_ARGS}; } # Process session options here. Several options may be set. if (exists $params{+CREATE_OPTIONS}) { if (ref($params{+CREATE_OPTIONS}) eq 'HASH') { $self->[SE_OPTIONS] = $params{+CREATE_OPTIONS}; } else { croak "options for $type constructor is expected to be a HASH reference"; } delete $params{+CREATE_OPTIONS}; } # Get down to the business of defining states. while (my ($param_name, $param_value) = each %params) { # Inline states are expected to be state-name/coderef pairs. if ($param_name eq CREATE_INLINES) { croak "$param_name does not refer to a hash" unless (ref($param_value) eq 'HASH'); while (my ($state, $handler) = each(%$param_value)) { croak "inline state for '$state' needs a CODE reference" unless (ref($handler) eq 'CODE'); $self->_register_state($state, $handler); } } # Package states are expected to be package-name/list-or-hashref # pairs. If the second part of the pair is a arrayref, then the # package methods are expected to be named after the states # they'll handle. If it's a hashref, then the keys are state # names and the values are package methods that implement them. elsif ($param_name eq CREATE_PACKAGES) { croak "$param_name does not refer to an array" unless (ref($param_value) eq 'ARRAY'); croak "the array for $param_name has an odd number of elements" if (@$param_value & 1); # Copy the parameters so they aren't destroyed. my @param_value = @$param_value; while (my ($package, $handlers) = splice(@param_value, 0, 2)) { # TODO What do we do if the package name has some sort of # blessing? Do we use the blessed thingy's package, or do we # maybe complain because the user might have wanted to make # object states instead? # An array of handlers. The array's items are passed through # as both state names and package method names. if (ref($handlers) eq 'ARRAY') { foreach my $method (@$handlers) { $self->_register_state($method, $package, $method); } } # A hash of handlers. Hash keys are state names; values are # package methods to implement them. elsif (ref($handlers) eq 'HASH') { while (my ($state, $method) = each %$handlers) { $self->_register_state($state, $package, $method); } } else { croak( "states for package '$package' " . "need to be a hash or array ref" ); } } } # Object states are expected to be object-reference/ # list-or-hashref pairs. They must be passed to &create in a list # reference instead of a hash reference because making object # references into hash keys loses their blessings. elsif ($param_name eq CREATE_OBJECTS) { croak "$param_name does not refer to an array" unless (ref($param_value) eq 'ARRAY'); croak "the array for $param_name has an odd number of elements" if (@$param_value & 1); # Copy the parameters so they aren't destroyed. my @param_value = @$param_value; while (@param_value) { my ($object, $handlers) = splice(@param_value, 0, 2); # Verify that the object is an object. This may catch simple # mistakes; or it may be overkill since it already checks that # $param_value is a arrayref. carp "'$object' is not an object" unless ref($object); # An array of handlers. The array's items are passed through # as both state names and object method names. if (ref($handlers) eq 'ARRAY') { foreach my $method (@$handlers) { $self->_register_state($method, $object, $method); } } # A hash of handlers. Hash keys are state names; values are # package methods to implement them. elsif (ref($handlers) eq 'HASH') { while (my ($state, $method) = each %$handlers) { $self->_register_state($state, $object, $method); } } else { croak "states for object '$object' need to be a hash or array ref"; } } } # Import an external heap. This is a convenience, since it # eliminates the need to connect _start options to heap values. elsif ($param_name eq CREATE_HEAP) { $self->[SE_NAMESPACE] = $param_value; } else { croak "unknown $type parameter: $param_name"; } } return $self->try_alloc(@args); } #------------------------------------------------------------------------------ sub DESTROY { my $self = shift; # Session's data structures are destroyed through Perl's usual # garbage collection. TRACE_DESTROY here just shows what's in the # session before the destruction finishes. TRACE_DESTROY and do { require Data::Dumper; POE::Kernel::_warn( "----- Session $self Leak Check -----\n", "-- Namespace (HEAP):\n", Data::Dumper::Dumper($self->[SE_NAMESPACE]), "-- Options:\n", ); foreach (sort keys (%{$self->[SE_OPTIONS]})) { POE::Kernel::_warn(" $_ = ", $self->[SE_OPTIONS]->{$_}, "\n"); } POE::Kernel::_warn("-- States:\n"); foreach (sort keys (%{$self->[SE_STATES]})) { POE::Kernel::_warn(" $_ = ", $self->[SE_STATES]->{$_}, "\n"); } }; } #------------------------------------------------------------------------------ sub _invoke_state { my ($self, $source_session, $state, $etc, $file, $line, $fromstate) = @_; # Trace the state invocation if tracing is enabled. if ($self->[SE_OPTIONS]->{+OPT_TRACE}) { POE::Kernel::_warn( $POE::Kernel::poe_kernel->ID_session_to_id($self), " -> $state (from $file at $line)\n" ); } # The desired destination state doesn't exist in this session. # Attempt to redirect the state transition to _default. unless (exists $self->[SE_STATES]->{$state}) { # There's no _default either; redirection's not happening today. # Drop the state transition event on the floor, and optionally # make some noise about it. unless (exists $self->[SE_STATES]->{+EN_DEFAULT}) { $! = exists &Errno::ENOSYS ? &Errno::ENOSYS : &Errno::EIO; if ($self->[SE_OPTIONS]->{+OPT_DEFAULT} and $state ne EN_SIGNAL) { my $loggable_self = $POE::Kernel::poe_kernel->_data_alias_loggable($self->ID); POE::Kernel::_warn( "a '$state' event was sent from $file at $line to $loggable_self ", "but $loggable_self has neither a handler for it ", "nor one for _default\n" ); } return undef; } # If we get this far, then there's a _default state to redirect # the transition to. Trace the redirection. if ($self->[SE_OPTIONS]->{+OPT_TRACE}) { POE::Kernel::_warn( $POE::Kernel::poe_kernel->ID_session_to_id($self), " -> $state redirected to _default\n" ); } # Transmogrify the original state transition into a corresponding # _default invocation. ARG1 is copied from $etc so it can't be # altered from a distance. $etc = [ $state, [@$etc] ]; $state = EN_DEFAULT; } # If we get this far, then the state can be invoked. So invoke it # already! # Inline states are invoked this way. if (ref($self->[SE_STATES]->{$state}) eq 'CODE') { return $self->[SE_STATES]->{$state}-> ( undef, # object $self, # session $POE::Kernel::poe_kernel, # kernel $self->[SE_NAMESPACE], # heap $state, # state $source_session, # sender undef, # unused #6 $file, # caller file name $line, # caller file line $fromstate, # caller state @$etc # args ); } # Package and object states are invoked this way. my ($object, $method) = @{$self->[SE_STATES]->{$state}}; return $object->$method # package/object (implied) ( $self, # session $POE::Kernel::poe_kernel, # kernel $self->[SE_NAMESPACE], # heap $state, # state $source_session, # sender undef, # unused #6 $file, # caller file name $line, # caller file line $fromstate, # caller state @$etc # args ); } #------------------------------------------------------------------------------ # Add, remove or replace states in the session. sub _register_state { my ($self, $name, $handler, $method) = @_; $method = $name unless defined $method; # Deprecate _signal. # RC 2004-09-07 - Decided to leave this in because it blames # problems with _signal on the user for using it. It should # probably go away after a little while, but not during the other # deprecations. if ($name eq EN_SIGNAL) { # Report the problem outside POE. my $caller_level = 0; local $Carp::CarpLevel = 1; while ( (caller $caller_level)[0] =~ /^POE::/ ) { $caller_level++; $Carp::CarpLevel++; } croak( ",----- DEPRECATION ERROR -----\n", "| The _signal event is deprecated. Please use sig() to register\n", "| an explicit signal handler instead.\n", "`-----------------------------\n", ); } # There is a handler, so try to define the state. This replaces an # existing state. if ($handler) { # Coderef handlers are inline states. if (ref($handler) eq 'CODE') { carp( "redefining handler for event($name) for session(", $POE::Kernel::poe_kernel->ID_session_to_id($self), ")" ) if ( $self->[SE_OPTIONS]->{+OPT_DEBUG} && (exists $self->[SE_STATES]->{$name}) ); $self->[SE_STATES]->{$name} = $handler; } # Non-coderef handlers may be package or object states. See if # the method belongs to the handler. elsif ($handler->can($method)) { carp( "redefining handler for event($name) for session(", $POE::Kernel::poe_kernel->ID_session_to_id($self), ")" ) if ( $self->[SE_OPTIONS]->{+OPT_DEBUG} && (exists $self->[SE_STATES]->{$name}) ); $self->[SE_STATES]->{$name} = [ $handler, $method ]; } # Something's wrong. This code also seems wrong, since # ref($handler) can't be 'CODE'. else { if ( (ref($handler) eq 'CODE') and $self->[SE_OPTIONS]->{+OPT_TRACE} ) { carp( $POE::Kernel::poe_kernel->ID_session_to_id($self), " : handler for event($name) is not a proper ref - not registered" ) } else { unless ($handler->can($method)) { if (length ref($handler)) { croak "object $handler does not have a '$method' method" } else { croak "package $handler does not have a '$method' method"; } } } } } # No handler. Delete the state! else { delete $self->[SE_STATES]->{$name}; } } #------------------------------------------------------------------------------ # Return the session's ID. This is a thunk into POE::Kernel, where # the session ID really lies. sub _set_id { my ($self, $id) = @_; $self->[SE_ID] = $id; } sub ID { return shift()->[SE_ID]; } #------------------------------------------------------------------------------ # Set or fetch session options. sub option { my $self = shift; my %return_values; # Options are set in pairs. while (@_ >= 2) { my ($flag, $value) = splice(@_, 0, 2); $flag = lc($flag); # If the value is defined, then set the option. if (defined $value) { # Change some handy values into boolean representations. This # clobbers the user's original values for the sake of DWIM-ism. ($value = 1) if ($value =~ /^(on|yes|true)$/i); ($value = 0) if ($value =~ /^(no|off|false)$/i); $return_values{$flag} = $self->[SE_OPTIONS]->{$flag}; $self->[SE_OPTIONS]->{$flag} = $value; } # Remove the option if the value is undefined. else { $return_values{$flag} = delete $self->[SE_OPTIONS]->{$flag}; } } # If only one option is left, then there's no value to set, so we # fetch its value. if (@_) { my $flag = lc(shift); $return_values{$flag} = ( exists($self->[SE_OPTIONS]->{$flag}) ? $self->[SE_OPTIONS]->{$flag} : undef ); } # If only one option was set or fetched, then return it as a scalar. # Otherwise return it as a hash of option names and values. my @return_keys = keys(%return_values); if (@return_keys == 1) { return $return_values{$return_keys[0]}; } else { return \%return_values; } } # Fetch the session's heap. In rare cases, libraries may need to # break encapsulation this way, probably also using # $kernel->get_current_session as an accessory to the crime. sub get_heap { my $self = shift; return $self->[SE_NAMESPACE]; } #------------------------------------------------------------------------------ # Create an anonymous sub that, when called, posts an event back to a # session. This maps postback references (stringified; blessing, and # thus refcount, removed) to parent session IDs. Members are set when # postbacks are created, and postbacks' DESTROY methods use it to # perform the necessary cleanup when they go away. Thanks to njt for # steering me right on this one. my %anonevent_parent_id; my %anonevent_weakened; # I assume that when the postback owner loses all reference to it, # they are done posting things back to us. That's when the postback's # DESTROY is triggered, and referential integrity is maintained. sub POE::Session::AnonEvent::DESTROY { my $self = shift; my $parent_id = delete $anonevent_parent_id{$self}; unless (delete $anonevent_weakened{$self}) { $POE::Kernel::poe_kernel->refcount_decrement( $parent_id, 'anon_event' ); } } sub POE::Session::AnonEvent::weaken { my $self = shift; unless ($anonevent_weakened{$self}) { my $parent_id = $anonevent_parent_id{$self}; $POE::Kernel::poe_kernel->refcount_decrement( $parent_id, 'anon_event' ); $anonevent_weakened{$self} = 1; } return $self; } # Tune postbacks depending on variations in toolkit behavior. BEGIN { # Tk blesses its callbacks internally, so we need to wrap our # blessed callbacks in unblessed ones. Otherwise our postback's # DESTROY method probably won't be called. if (exists $INC{'Tk.pm'}) { eval 'sub USING_TK () { 1 }'; } else { eval 'sub USING_TK () { 0 }'; } }; # Create a postback closure, maintaining referential integrity in the # process. The next step is to give it to something that expects to # be handed a callback. sub postback { my ($self, $event, @etc) = @_; my $id = $POE::Kernel::poe_kernel->ID_session_to_id($self); my $postback = bless sub { $POE::Kernel::poe_kernel->post( $id, $event, [ @etc ], [ @_ ] ); return 0; }, 'POE::Session::AnonEvent'; $anonevent_parent_id{$postback} = $id; $POE::Kernel::poe_kernel->refcount_increment( $id, 'anon_event' ); # Tk blesses its callbacks, so we must present one that isn't # blessed. Otherwise Tk's blessing would divert our DESTROY call to # its own, and that's not right. return sub { $postback->(@_) } if USING_TK; return $postback; } # Create a synchronous callback closure. The return value will be # passed to whatever is handed the callback. sub callback { my ($self, $event, @etc) = @_; my $id = $POE::Kernel::poe_kernel->ID_session_to_id($self); my $callback = bless sub { $POE::Kernel::poe_kernel->call( $id, $event, [ @etc ], [ @_ ] ); }, 'POE::Session::AnonEvent'; $anonevent_parent_id{$callback} = $id; $POE::Kernel::poe_kernel->refcount_increment( $id, 'anon_event' ); # Tk blesses its callbacks, so we must present one that isn't # blessed. Otherwise Tk's blessing would divert our DESTROY call to # its own, and that's not right. return sub { $callback->(@_) } if USING_TK; return $callback; } 1; __END__ =head1 NAME POE::Session - a generic event-driven task =head1 SYNOPSIS use POE; # auto-includes POE::Kernel and POE::Session POE::Session->create( inline_states => { _start => sub { $_[KERNEL]->yield("next") }, next => sub { print "tick...\n"; $_[KERNEL]->delay(next => 1); }, }, ); POE::Kernel->run(); exit; POE::Session can also dispatch to object and class methods through L and L callbacks. =head1 DESCRIPTION POE::Session and its subclasses translate events from POE::Kernel's generic dispatcher into the particular calling conventions suitable for application code. In design pattern parlance, POE::Session classes are adapters between L and application code. The L that POE::Kernel manages are more like generic task structures. Unfortunately these two disparate concepts have virtually identical names. =head2 A note on nomenclature This documentation will refer to event handlers as "states" in certain unavoidable situations. Sessions were originally meant to be event-driven state machines, but their purposes evolved over time. Some of the legacy vocabulary lives on in the API for backward compatibility, however. Confusingly, L is a class for implementing actual event-driven state machines. Its documentation uses "state" in the proper sense. =head1 USING POE::Session POE::Session has two main purposes. First, it maps event names to the code that will handle them. Second, it maps a consistent event dispatch interface to those handlers. Consider the L for example. A POE::Session instance is created with two C, each mapping an event name ("_start" and "next") to an inline subroutine. POE::Session ensures that L and so on are meaningful within an event handler. Event handlers may also be object or class methods, using L and L respectively. The create() syntax is different than for C, but the calling convention is nearly identical. Notice that the created POE::Session object has not been saved to a variable. The new POE::Session object gives itself to POE::Kernel, which then manages it and all the resources it uses. It's possible to keep references to new POE::Session objects, but it's not usually necessary. If an application is not careful about cleaning up these references you will create circular references, which will leak memory when POE::Kernel would normally destroy the POE::Session object. It is recommended that you keep the session's L instead. =head2 POE::Session's Calling Convention The biggest syntactical hurdle most people have with POE is POE::Session's unconventional calling convention. For example: sub handle_event { my ($kernel, $heap, $parameter) = @_[KERNEL, HEAP, ARG0]; ...; } Or the use of C<$_[KERNEL]>, C<$_[HEAP]> and C<$_[ARG0]> inline, as is done in most examples. What's going on here is rather basic. Perl passes parameters into subroutines or methods using the @_ array. C, C, C and others are constants exported by POE::Session (which is included for free when a program uses POE). So C<$_[KERNEL]> is an event handler's KERNELth parameter. C<@_[HEAP, ARG0]> is a slice of @_ containing the HEAPth and ARG0th parameters. While this looks odd, it's perfectly plain and legal Perl syntax. POE uses it for a few reasons: =over 4 =item 1 In the common case, passing parameters in C<@_> is faster than passing hash or array references and then dereferencing them in the handler. =item 2 Typos in hash-based parameter lists are either subtle run-time errors or requires constant run-time checking. Constants are either known at compile time, or are clear compile-time errors. =item 3 Referencing C<@_> offsets by constants allows parameters to move in the future without breaking application code. =item 4 Most event handlers don't need all of C<@_>. Slices allow handlers to use only the parameters they're interested in. =back =head2 POE::Session Parameters Event handlers receive most of their run-time context in up to nine callback parameters. POE::Kernel provides many of them. =head3 $_[OBJECT] C<$_[OBJECT]> is $self for event handlers that are an object method. It is the class (package) name for class-based event handlers. It is undef for plain coderef callbacks, which have no special C<$self>-ish value. C is always zero, since C<$_[0]> is always C<$self> or C<$class> in object and class methods. Coderef handlers are called with an C placeholder in C<$_[0]> so that the other offsets remain valid. It's often useful for method-based event handlers to call other methods in the same object. C<$_[OBJECT]> helps this happen. sub ui_update_everything { my $self = $_[OBJECT]; $self->update_menu(); $self->update_main_window(); $self->update_status_line(); } You may also use method inheritance. Here we invoke $self->a_method(@_). Since Perl's C<< -> >> operator unshifts $self onto the beginning of @_, we must first shift a copy off to maintain POE's parameter offsets: sub a_method { my $self = shift; $self->SUPER::a_method( @_ ); # ... more work ... } =head3 $_[SESSION] C<$_[SESSION]> is a reference to the current session object. This lets event handlers access their session's methods. Programs may also compare C<$_[SESSION]> to C<$_[SENDER]> to verify that intra-session events did not come from other sessions. C<$_[SESSION]> may also be used as the destination for intra-session L and L. L is marginally more convenient and efficient than C however. It is bad form to access another session directly. The recommended approach is to manipulate a session through an event handler. sub enable_trace { my $previous_trace = $_[SESSION]->option( trace => 1 ); my $id = $_[SESSION]->ID; if ($previous_trace) { print "Session $id: dispatch trace is still on.\n"; } else { print "Session $id: dispatch trace has been enabled.\n"; } } =head3 $_[KERNEL] The KERNELth parameter is always a reference to the application's singleton L instance. It is most often used to call POE::Kernel methods from event handlers. # Set a 10-second timer. $_[KERNEL]->delay( time_is_up => 10 ); =head3 $_[HEAP] Every POE::Session object contains its own variable namespace known as the session's C. It is modeled and named after process memory heaps (not priority heaps). Heaps are by default anonymous hash references, but they may be initialized in L to be almost anything. POE::Session itself never uses C<$_[HEAP]>, although some POE components do. Heaps do not overlap between sessions, although create()'s "heap" parameter can be used to make this happen. These two handlers time the lifespan of a session: sub _start_handler { $_[HEAP]{ts_start} = time(); } sub _stop_handler { my $time_elapsed = time() - $_[HEAP]{ts_start}; print "Session ", $_[SESSION]->ID, " elapsed seconds: $elapsed\n"; } =head3 $_[STATE] The STATEth handler parameter contains the name of the event being dispatched in the current callback. This can be important since the event and handler names may significantly differ. Also, a single handler may be assigned to more than one event. POE::Session->create( inline_states => { one => \&some_handler, two => \&some_handler, six => \&some_handler, ten => \&some_handler, _start => sub { $_[KERNEL]->yield($_) for qw(one two six ten); } } ); sub some_handler { print( "Session ", $_[SESSION]->ID, ": some_handler() handled event $_[STATE]\n" ); } It should be noted however that having event names and handlers names match will make your code easier to navigate. =head3 $_[SENDER] Events must come from somewhere. C<$_[SENDER]> contains the currently dispatched event's source. C<$_[SENDER]> is commonly used as a return address for responses. It may also be compared against C<$_[KERNEL]> to verify that timers and other POE::Kernel-generated events were not spoofed. This C responds to the sender with an "echo" event that contains all the parameters it received. It avoids a feedback loop by ensuring the sender session and event (STATE) are not identical to the current ones. sub echo_handler { return if $_[SENDER] == $_[SESSION] and $_[STATE] eq "echo"; $_[KERNEL]->post( $_[SENDER], "echo", @_[ARG0..$#_] ); } =for comment TODO - Document which events should have $_[SENDER] == $_[KERNEL]. Probably in POE::Kernel.> =head3 $_[CALLER_FILE], $_[CALLER_LINE] and $_[CALLER_STATE] These parameters are a form of caller(), but they describe where the currently dispatched event originated. CALLER_FILE and CALLER_LINE are fairly plain. CALLER_STATE contains the name of the event that was being handled when the event was created, or when the event watcher that ultimately created the event was registered. =for comment TODO - Rename SENDER_FILE, SENDER_LINE, SENDER_STATE? =head3 @_[ARG0..ARG9] or @_[ARG0..$#_] Parameters $_[ARG0] through the end of @_ contain parameters provided by application code, event watchers, or higher-level libraries. These parameters are guaranteed to be at the end of @_ so that @_[ARG0..$#_] will always catch them all. $#_ is the index of the last value in @_. Blame Perl if it looks odd. It's merely the $#array syntax where the array name is an underscore. Consider $_[KERNEL]->yield( ev_whatever => qw( zero one two three ) ); The handler for ev_whatever will be called with "zero" in $_[ARG0], "one" in $_[ARG1], and so on. @_[ARG0..$#_] will contain all four words. sub ev_whatever { $_[OBJECT]->whatever( @_[ARG0..$#_] ); } =head2 Using POE::Session With Objects One session may handle events across many objects. Or looking at it the other way, multiple objects can be combined into one session. And what the heck---go ahead and mix in some inline code as well. POE::Session->create( object_states => [ $object_1 => { event_1a => "method_1a" }, $object_2 => { event_2a => "method_2a" }, ], inline_states => { event_3 => \&piece_of_code, }, ); However only one handler may be assigned to a given event name. Duplicates will overwrite earlier ones. event_1a is handled by calling C<< $object_1->method_1a(...) >>. C<$_[OBJECT]> is C<$object_1> in this case. C<$_[HEAP]> belongs to the session, which means anything stored there will be available to any other event handler regardless of the object. event_2a is handled by calling C<< $object_2->method_2a(...) >>. In this case C<$_[OBJECT]> is $object_2. C<$_[HEAP]> is the same anonymous hashref that was passed to the event_1a handler, though. The methods are resolved when the event is handled (late-binding). event_3 is handled by calling C. C<$_[OBJECT]> is C here because there's no object. And once again, C<$_[HEAP]> is the same shared hashref that the handlers for event_1a and event_2a saw. Interestingly, there's no technical reason that a single object can't handle events from more than one session: for (1..2) { POE::Session->create( object_states => [ $object_4 => { event_4 => "method_4" }, ] ); } Now C<< $object_4->method_4(...) >> may be called to handle events from one of two sessions. In both cases, C<$_[OBJECT]> will be C<$object_4>, but C<$_[HEAP]> will hold data for a particular session. The same goes for inline states. One subroutine may handle events from many sessions. C<$_[SESSION]> and C<$_[HEAP]> can be used within the handler to easily access the context of the session in which the event is being handled. =head1 PUBLIC METHODS POE::Session has just a few public methods. =head2 create LOTS_OF_STUFF C starts a new session running. It returns a new POE::Session object upon success, but most applications won't need to save it. C invokes the newly started session's _start event handler before returning. C also passes the new POE::Session object to L. POE's kernel holds onto the object in order to dispatch events to it. POE::Kernel will release the object when it detects the object has become moribund. This should cause Perl to destroy the object if application code has not saved a copy of it. C accepts several named parameters, most of which are optional. Note however that the parameters are not part of a hashref. =for comment Is it time to bring new() back as a synonym for create()? PG - NO! IMHO ->new implies simply creating the object, and that you have to hold onto the object. ->create implies other actions are happening, and that you don't want to hold on to it. =for comment TODO - Provide forward-compatible "handler" options and methods as synonyms for the "state" versions currently supported? PG - No, that's for 1.01 =for comment TODO - Add a "class_handlers" as a synonym for "package_handlers"? PG - Maybe. However, to many synonyms can be a pain for an API. =for comment TODO - The above TODOs may be summarized: "deprecate old language"? PG - Oh, you are thinking of deprecating the old language... erm... no? =for comment TODO PG - I notice these =head3 are in alphabetical order. I think TODO all the *_states options should be together. Followed by heap, args, TODO options =head3 args => ARRAYREF The C parameter accepts a reference to a list of parameters that will be passed to the session's _start event handler in C<@_> positions C through C<$#_> (the end of C<@_>). This example would print "arg0 arg1 etc.": POE::Session->create( inline_states => { _start => sub { print "Session started with arguments: @_[ARG0..$#_]\n"; }, }, args => [ 'arg0', 'arg1', 'etc.' ], ); =head3 heap => ANYTHING The C parameter allows a session's heap to be initialized differently at instantiation time. Heaps are usually anonymous hashrefs, but C may set them to be array references or even objects. This example prints "tree": POE::Session->create( inline_states => { _start => sub { print "Slot 0 = $_[HEAP][0]\n"; }, }, heap => [ 'tree', 'bear' ], ); Be careful when initializing the heap to be something that doesn't behave like a hashref. Some libraries assume hashref heap semantics, and they will fail if the heap doesn't work that way. =head3 inline_states => HASHREF C maps events names to the subroutines that will handle them. Its value is a hashref that maps event names to the coderefs of their corresponding handlers: POE::Session->create( inline_states => { _start => sub { print "arg0=$_[ARG0], arg1=$_[ARG1], etc.=$_[ARG2]\n"; }, _stop => \&stop_handler, }, args => [qw( arg0 arg1 etc. )], ); The term "inline" comes from the fact that coderefs can be inlined anonymous subroutines. Be very careful with closures, however. L. =head3 object_states => ARRAYREF C associates one or more objects to a session and maps event names to the object methods that will handle them. It's value is an C; C would stringify the objects, ruining them for method invocation. Here _start is handled by C<< $object->_session_start() >> and _stop triggers C<< $object->_session_stop() >>: POE::Session->create( object_states => [ $object => { _start => '_session_start', _stop => '_session_stop', } ] ); POE::Session also supports a short form where the event and method names are identical. Here _start invokes $object->_start(), and _stop triggers $object->_stop(): POE::Session->create( object_states => [ $object => [ '_start', '_stop' ], ] ); Methods are verified when the session is created, but also resolved when the handler is called (late binding). Most of the time, a method won't change. But in some circumstance, such as dynamic inheritance, a method could resolve to a different subroutine. =head3 options => HASHREF POE::Session sessions support a small number of options, which may be initially set with the C