Skip to content
Browse files

Move Philip Gwyn's signals test to POE::Test::Loops, so it can

exercise everyone's event loops.
  • Loading branch information...
1 parent a88bc2c commit 364246096c8de24e9ff51e83343407a8b2faa5d4 @rcaputo committed
Showing with 4 additions and 11,758 deletions.
  1. +2 −1 poe-test-loops/MANIFEST
  2. +2 −0 poe/t/90_regression/leolo-poe-wheel-run.t → poe-test-loops/lib/POE/Test/Loops/z_leolo_wheel_run.pm
  3. +0 −464 poe/HISTORY
  4. +0 −153 poe/MANIFEST
  5. +0 −30 poe/MANIFEST.SKIP
  6. +0 −78 poe/Makefile.PL
  7. +0 −94 poe/README
  8. +0 −20 poe/TODO
  9. +0 −17 poe/docs/Makefile
  10. +0 −55 poe/docs/POE-HINTS.outline
  11. +0 −1,856 poe/docs/POE-TODO.outline
  12. +0 −357 poe/docs/out-out.perl
  13. +0 −3 poe/examples/README.samples
  14. +0 −229 poe/examples/create.perl
  15. +0 −177 poe/examples/fakelogin.perl
  16. +0 −186 poe/examples/forkbomb.perl
  17. +0 −323 poe/examples/names.perl
  18. +0 −143 poe/examples/objmaps.perl
  19. +0 −137 poe/examples/objsessions.perl
  20. +0 −125 poe/examples/packagesessions.perl
  21. +0 −145 poe/examples/queue.perl
  22. +0 −378 poe/examples/selects.perl
  23. +0 −212 poe/examples/sessions.perl
  24. +0 −121 poe/examples/signals.perl
  25. +0 −162 poe/examples/tcp_watermarks.perl
  26. +0 −470 poe/examples/thrash.perl
  27. +0 −199 poe/examples/watermarks.perl
  28. +0 −160 poe/examples/wheels2.perl
  29. +0 −689 poe/lib/POE.pm
  30. +0 −121 poe/lib/POE/Component.pm
  31. +0 −806 poe/lib/POE/Component/Client/TCP.pm
  32. +0 −1,375 poe/lib/POE/Component/Server/TCP.pm
  33. +0 −169 poe/lib/POE/Driver.pm
  34. +0 −255 poe/lib/POE/Driver/SysRW.pm
  35. +0 −367 poe/lib/POE/Filter.pm
  36. +0 −282 poe/lib/POE/Filter/Block.pm
  37. +0 −237 poe/lib/POE/Filter/Grep.pm
  38. +0 −539 poe/lib/POE/Filter/HTTPD.pm
  39. +0 −380 poe/lib/POE/Filter/Line.pm
  40. +0 −243 poe/lib/POE/Filter/Map.pm
Sorry, we could not display the entire diff because it was too big.
View
3 poe-test-loops/MANIFEST
@@ -31,8 +31,9 @@ lib/POE/Test/Loops/wheel_sf_udp.pm
lib/POE/Test/Loops/wheel_sf_unix.pm
lib/POE/Test/Loops/wheel_tail.pm
lib/POE/Test/Loops/z_kogman_sig_order.pm
+lib/POE/Test/Loops/z_leolo_wheel_run.pm
lib/POE/Test/Loops/z_merijn_sigchld_system.pm
-# TODO - Why does this segfault for others: lib/POE/Test/Loops/z_rt39872_sigchld.pm
+lib/POE/Test/Loops/z_rt39872_sigchld.pm
lib/POE/Test/Loops/z_rt39872_sigchld_stop.pm
lib/POE/Test/Loops/z_steinert_signal_integrity.pm
t/01_no_tests.t
View
2 poe/t/90_regression/leolo-poe-wheel-run.t → ...s/lib/POE/Test/Loops/z_leolo_wheel_run.pm
@@ -117,3 +117,5 @@ sub spawn
}
);
}
+
+1;
View
464 poe/HISTORY
@@ -1,464 +0,0 @@
-$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 <troc@shadow.net>; 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" <troc@shadow.net>
-To: "Felix Gallo" <fgallo@wellspring.us.dg.com>,
- "perl5-porters@perl.org" <perl5-porters@perl.org>
-Date: Fri, 07 Feb 97 08:54:23 -0400
-Reply-To: "Rocco Caputo" <troc@shadow.net>
-Priority: Normal
-Subject: portable multithreading
-Resent-Message-ID: <"O2kshC.A.W5C.lTz-y"@sinistar>
-Resent-From: perl5-porters@perl.org
-X-Mailing-List: <perl5-porters@perl.org> 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
-<troc@shadow.net>
-
--------------------------------------------------------------------------------
-
-Received: from sinistar.idle.com ([198.109.160.36])
- by anshar.shadow.net (8.8.5/8.7.3) with ESMTP id VAA13861
- for <troc@shadow.net>; 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" <troc@shadow.net>
-To: "Gary Howland" <gary@systemics.com>,
- "Tom Christiansen" <tchrist@jhereg.perl.com>
-Cc: "Gary Howland" <gary@systemics.com>, "Hugo van der Sanden" <hv@iii.co.uk>,
- "hv@tyree.iii.co.uk" <hv@tyree.iii.co.uk>,
- "perl5-porters@perl.org" <perl5-porters@perl.org>
-Date: Mon, 14 Apr 97 20:34:01 -0500
-Reply-To: "Rocco Caputo" <troc@shadow.net>
-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: <perl5-porters@idle.com> 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
-<http://www.shadow.net/~troc/perlstuff.html>. If this code is useful
-to anyone, I'd sure like to know.
-
-Rocco
-<troc@shadow.net>
-
-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 <troc@shadow.net>; 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" <troc@shadow.net>
-To: "Felix Gallo" <fgallo@wellspring.us.dg.com>,
- "perl5-porters@perl.org" <perl5-porters@perl.org>
-Date: Fri, 07 Feb 97 08:54:31 -0400
-Reply-To: "Rocco Caputo" <troc@shadow.net>
-Priority: Normal
-Subject: polytheistic perl references
-Resent-Message-ID: <"1y3hHB.A.w5C.sTz-y"@sinistar>
-Resent-From: perl5-porters@perl.org
-X-Mailing-List: <perl5-porters@perl.org> 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 <http://www.nexi.com/troc>. The code is inside
-a larger package, Serv+Face, at
-<http://www.shadow.net/~troc/perlstuff.html>.
-
-Just some ideas to ponder.
-
-Rocco
-<troc@shadow.net>
-
--------------------------------------------------------------------------------
-
-This is a header from a program I was writing before I discovered Perl.
-
-// =========================================================================
-// UBERSYS.H
-// UberSys definitions and classes.
-// =========================================================================
-
-#include <io.h>
-#include <dir.h>
-#include <dos.h>
-#include <math.h>
-#include <time.h>
-#include <alloc.h>
-#include <conio.h>
-#include <ctype.h>
-#include <fcntl.h>
-#include <share.h>
-#include <stdio.h>
-#include <setjmp.h>
-#include <stdarg.h>
-#include <stddef.h>
-#include <stdlib.h>
-#include <string.h>
-#include <values.h>
-#include <fstream.h>
-#include <iomanip.h>
-#include <iostream.h>
-#include <sys\stat.h>
-
-// -------------------------------------------------------------------------
-// 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 <class T>
-T max(T x, T y)
-{
- return((x>y)?x:y);
-};
- // minimum of two values
-template <class T>
-T min(T x, T y)
-{
- return((x<y)?x:y);
-};
- // inline assembly shorthand
-#define I asm
-
-#define FATAL fatalerr(thisFile,__LINE__)
-#define FATALH(x) fatalerr(x,__LINE__)
-
-#if defined(DEBUG)
-# define ERRS if(errorstream)*errorstream<<setiosflags(ios::uppercase)<<hex
-# define CRV(x) if((x)==RV_FAILURE)FATAL
-# define CNE(x) if((x)==-1)FATAL
-# define CZE(x) if(!(x))FATAL
-# define FLINE ,thisFile,__LINE__
-# define FLINC thisFile,__LINE__
-# define FLINP , char *file, int line
-# define FLINQ char *file, int line
-# define FLINI ,file,line
-# define FLINJ file,line
-# define FLINS thisFile,__LINE__,
-# define FLINT char *file, int line,
-# define FLI dec<<");\t\t// f:"<<setw(12)<<file<<" @ l:"<<setw(4)<<line
-# define BOTH(x) A20(x)<<" ["<<A20(*(x))<<"]"
-# define DEB(x) x
-# define DEB2(x,y) x,y
-# define NEW ERRS<<dec<<"\nCall to new.\t\t\t\t\t// f:"<<setw(12)<<thisFile<<" @ l:"<<setw(4)<<__LINE__;
-# define DEL ERRS<<dec<<"\nCall to delete.\t\t\t\t\t// f:"<<setw(12)<<thisFile<<" @ l:"<<setw(4)<<__LINE__;
-# define WHEREAMI ERRS<<dec<<"\nInside file "<<thisFile<<" @ line "<<__LINE__;
-# define ORPHANS { ERRS<<dec<<"\nOrphan check in "<<thisFile<<" @ line "<<__LINE__<<". "; CRV(aOrphans(FLINC)); }
-# define VALID(dp) CZE(aValid(aHeader(dp)));
-# define DUMP aDump(FLINC);
-#else
-# define ERRS cerr
-# define CRV(x) x
-# define CNE(x) x
-# define FLINE
-# define FLINC
-# define FLINP
-# define FLINQ void
-# define FLINI
-# define FLINJ
-# define FLINS
-# define FLINT
-# define DEB(x)
-# define DEB2(x,y)
-# define NEW
-# define DEL
-# define WHEREAMI
-# define ORPHANS
-# define VALID(dp)
-# define DUMP
-#endif
-
-#define FALSE 0
-#define TRUE (~FALSE)
-
-// -------------------------------------------------------------------------
-
-void fatalerr(char *file, int line);
-
-extern char *buildbuf;
-
-// -------------------------------------------------------------------------
- // Paradox Engine header
-#include "pxengine.h"
- // Error stream if debugging.
-DEB(extern ofstream *errorstream;)
- // Message file header.
-#include "general.h"
- // Type definitions.
-#include "mytypes.h"
- // Database functions.
-#include "pxe.h"
-#include "users.h"
-#include "ipx.h"
- // Code groups.
-#include "pcodes.h"
-#include "gsbl.h"
-#include "arena.h"
-#include "interrup.h"
-#include "port.h"
-#include "msgfile.h"
-#include "task.h"
-#include "tam.h"
-#include "qualpath.h"
-#include "xmm.h"
-#include "var.h"
-#include "safepxi.h"
-#include "template.h"
-#include "token.h"
-#include "stack.h"
-#include "objfile.h"
-#include "ofm.h"
-#include "srcfile.h"
-#include "pmachine.h"
- // BBS modules.
-#include "hangup.h"
-#include "idle.h"
-#include "login.h"
-#include "editor.h"
-#include "cmdline.h"
-#include "console.h"
-#include "dirlist.h"
-#include "compiler.h"
-#include "disasm.h"
-#include "runtime.h"
-
-// -------------------------------------------------------------------------
-
-extern TAM *tam;
-
--------------------------------------------------------------------------------
-
-Light was let be.
View
153 poe/MANIFEST
@@ -1,153 +0,0 @@
-CHANGES
-HISTORY
-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/Event.pm
-lib/POE/Loop/Gtk.pm
-lib/POE/Loop/IO_Poll.pm
-lib/POE/Loop/PerlSignals.pm
-lib/POE/Loop/Select.pm
-lib/POE/Loop/Tk.pm
-lib/POE/Loop/TkActiveState.pm
-lib/POE/Loop/TkCommon.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/Events.pm
-lib/POE/Resource/Extrefs.pm
-lib/POE/Resource/FileHandles.pm
-lib/POE/Resource/Sessions.pm
-lib/POE/Resource/SIDs.pm
-lib/POE/Resource/Signals.pm
-lib/POE/Resource/Statistics.pm
-lib/POE/Resources.pm
-lib/POE/Session.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
-Makefile.PL
-MANIFEST This list of files
-MANIFEST.SKIP
-META.yml
-mylib/coverage.perl
-mylib/cpan-test.perl
-mylib/Devel/Null.pm
-mylib/events_per_second.pl
-mylib/gen-meta.perl
-mylib/gen-tests.perl
-mylib/Makefile-5004.pm
-mylib/Makefile-5005.pm
-mylib/MyOtherFreezer.pm
-mylib/PoeBuildInfo.pm
-mylib/svn-log.perl
-README
-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/README.samples
-examples/selects.perl
-examples/sessions.perl
-examples/signals.perl
-examples/tcp_watermarks.perl
-examples/thrash.perl
-examples/watermarks.perl
-examples/wheels2.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/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_explicit_loop.t
-t/10_units/03_base/17_explicit_loop_fail.t
-t/10_units/03_base/18_nfa_usage.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/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/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/20_resources/00_base/statistics.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/neyuki_detach.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/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/whelan-dieprop.t
-t/90_regression/whjackson-followtail.t
-TODO
View
30 poe/MANIFEST.SKIP
@@ -1,30 +0,0 @@
-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
-~$
View
78 poe/Makefile.PL
@@ -1,78 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use ExtUtils::MakeMaker;
-use Config;
-
-# 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";
-
-# Which kind of makefile should we build?
-
-if ($] < 5.005004) {
- warn(
- "\n",
- "===============================================================\n",
- "\n",
- "Please upgrade Perl to avoid lapses in support. Perl 5.005_04\n",
- "or newer is preferred. Support for older versions will be\n",
- "phased out in the future.\n",
- "\n",
- "Thank you.\n",
- "\n",
- "===============================================================\n",
- "\n",
- );
-
- require "./mylib/Makefile-5004.pm";
-}
-else {
- require "./mylib/Makefile-5005.pm";
-}
-
-1;
View
94 poe/README
@@ -1,94 +0,0 @@
-$Id$
-
---------------------
-Detailed Information
---------------------
-
-POE is bigger than this README. Please see http://poe.perl.org/ for
-more information.
-
----------------------
-Documentation Roadmap
----------------------
-
-POE includes a lot of documentation. The main POE man page includes
-references to everything else.
-
-POE has been around for a while. The CHANGES file has been limited to
-changes in the past year to help keep the distribution size down.
-POE's web site includes a complete change history broken down by
-release.
-
---------------
-Installing POE
---------------
-
-POE can be installed through the CPAN or CPANPLUS shell in the usual
-manner.
-
- % perl -MCPAN -e shell
- cpan> 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
-<bug-POE@rt.cpan.org>.
-
--------------
-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%27s_test_coverage_report
-
------------
-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/
View
20 poe/TODO
@@ -1,20 +0,0 @@
-$Id$
-
-------------------
-Where Did This Go?
-------------------
-
-The contents of this file have moved to the 'web. You can find them
-at <http://poe.perl.org/?POE_RFCs>.
-
-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 <http://poe.perl.org/> for information on acquiring an
-account on the site and setting your editing and viewing preferences.
-
----------------------------
-EOF: Thank you for reading.
----------------------------
View
17 poe/docs/Makefile
@@ -1,17 +0,0 @@
-#
-## Build POD docs from emacs outlines.
-## $Id$
-
-all: ../POE.pod ../POE-TODO.pod ../POE-HINTS.pod
-
-../POE.pod: ./POE.outline
- ./out-out.perl pod ./POE.outline > ../POE.pod
- ./out-out.perl html ./POE.outline > ../POE.html
-
-../POE-TODO.pod: ./POE-TODO.outline
- ./out-out.perl pod ./POE-TODO.outline > ../POE-TODO.pod
- ./out-out.perl html ./POE-TODO.outline > ../POE-TODO.html
-
-../POE-HINTS.pod: ./POE-HINTS.outline
- ./out-out.perl pod ./POE-HINTS.outline > ../POE-HINTS.pod
- ./out-out.perl html ./POE-HINTS.outline > ../POE-HINTS.html
View
55 poe/docs/POE-HINTS.outline
@@ -1,55 +0,0 @@
-*NAME #� -*- outline -*- �
-POE-HINTS - POE Hints
-*DESCRIPTION
-These are hints for using POE. It's sort of like a faq, only without
-the questions.
-
-**Events and Things
-Events and event-like things can be confusing. Here are some gotchas
-people have noted.
-
-***Event Names vs. Code References
-The difference between code references and event names may at first be
-confusing. There have been reports of people trying to use them
-interchangeably, causing lots of mental pain when it doesn't work.
-
-Just about the only time a code reference is needed is when states are
-defined. After that, states should almost always be referenced by
-event name.
-
-Uh, this doesn't sound very convincing. I should probably go into it
-in a little more detail in the next revision.
-**Session Resources
-Session resources are things that the session and/or kernel manage
-with high-level functions. These include alarms, selects and aliases.
-
-Wheels are also considered session resources, because they use
-first-order resources internally.
-
-***Notes About Session Resources
-B�Don't cross the streams. It would be bad.�
-
-Session resources are not designed to be manipulated from outside the
-sessions that own them. One session may not set or remove alarms in
-another. Nor may sessions set selects on behalf of others.
-
-In the case of wheels, one session may not directly call another's
-wheel's methods. $some_other_sessions_wheel->put(...) will not work
-as expected. Internally, the wheel will call &Kernel::select_write;
-this turns on/off a write select in the currently active session--
-which is the caller's session.
-
-The workaround for this is to create a "put" state in the wheel
-owner's session and &Kernel::post or &Kernel::call to that state. The
-post or call changes the active session to the wheel owner. The
-&Wheel::put call will then work as expected.
-
-Breaking session encapsulation was not considered during POE's design.
-*AUTHORS
-This document is the result of feedback from POE users. If you have
-questions or comments that aren't covered by this hints file, please
-contact the author. Even better, subscribe to the POE mailing list.
-
-This document is Copyright 1999 Rocco Caputo <troc@netrus.net>. All
-rights reserved. This document is free text; you may redistribute it
-and/or modify it under the same terms as Perl itself.
View
1,856 poe/docs/POE-TODO.outline
0 additions, 1,856 deletions not shown because the diff is too large. Please use a local Git client to view these changes.
View
357 poe/docs/out-out.perl
@@ -1,357 +0,0 @@
-#!/usr/bin/perl -w
-# $Id$
-
-use strict;
-
-my $output_type = shift;
-die "$0: bad output tipe '$output_type'\n"
- unless (($output_type eq 'html') || ($output_type eq 'pod'));
-
-sub ST_HEADING () { 'heading list'; }
-sub ST_PLAIN () { 'plain text'; }
-sub ST_BQUOTE () { 'bquote text'; }
-sub ST_BOF () { 'begin'; }
-sub ST_PARAGRAPH () { 'paragraph'; }
-sub ST_ENUMLIST () { 'enum list'; }
-sub ST_BULLETLIST () { 'bullet list'; }
-sub ST_EOF () { 'cease'; }
-sub ST_DOCUMENT () { 'new document'; }
-sub ST_SECTION () { 'new section'; }
-sub ST_BACKOUT () { 'close head'; }
-
-my @list_counts;
-
-my @html_head =
-( [ '*', '+0' ],
- [ 'I', '+1' ], [ 'A', '+1' ], [ '1', '+1' ], [ 'a', '+0' ], [ 'i', '+0' ],
- [ 'a', '+0' ], [ 'i', '+0' ], [ 'a', '+0' ], [ 'i', '+0' ], [ 'a', '+0' ],
-);
- # stolen^Wmodeled after Perl POD
-my %handler =
-( 'html' =>
- { 'I' => sub { "<i>" . $_[0] . "</i>"; },
- 'B' => sub { "<b>" . $_[0] . "</b>"; },
- 'S' => sub { my $txt = shift; $txt =~ s/ /\&\#160;/g; $txt; },
- 'C' => sub { "<code>" . $_[0] . "</code>"; },
- 'F' => sub { "<tt>" . $_[0] . "</tt>"; },
- 'Z' => sub { '' },
- 'E' => sub { "\&\#" . $_[0] . ";"; },
- '#' => sub { ""; },
- },
- 'pod' =>
- { 'I' => sub { "I<" . $_[0] . ">"; },
- 'B' => sub { "B<" . $_[0] . ">"; },
- 'S' => sub { "S<" . $_[0] . ">"; },
- 'C' => sub { "C<" . $_[0] . ">"; },
- 'F' => sub { "F<" . $_[0] . ">"; },
- 'Z' => sub { "Z<>" },
- 'E' => sub { "E<" . $_[0] . ">"; },
- '#' => sub { ""; },
- },
-);
-
-my $state = ST_BOF;
-my $last_index = 0;
-my $plain_buffer = '';
-
-use Carp;
-
-sub preprocess_html {
- my $text = shift;
- croak "no text" unless (defined $text);
- $text =~ s/\&/\&\#38;/g;
- $text =~ s/\</\&\#60;/g;
- $text =~ s/\>/\&\#62;/g;
- $text;
-}
-
-sub preprocess_pod {
- my $text = shift;
- $text =~ s/([&<>])/"E<" . ord($1) .">"/ge;
- $text;
-}
-
-my %preprocessors =
-( 'html' => \&preprocess_html,
- 'pod' => \&preprocess_pod,
-);
-
-sub filter_text {
- my $text = shift;
-
- $text = &{$preprocessors{$output_type}}($text);
-
- while ($text =~ /^(.*?)(\S)®(.*?)¯(.*)$/) {
- my ($left, $tag, $mid, $right) = ($1, $2, $3, $4);
- if (exists $handler{$output_type}->{$tag}) {
- $mid = &{$handler{$output_type}->{$tag}}($mid);
- }
- else {
- $mid = " [unknown tag $tag] " . $mid;
- }
- $text = $left . $mid . $right;
- }
-
- $text;
-}
-
-sub flush_text {
- my $flush_state = shift;
-
- if ($plain_buffer ne '') {
- if ($flush_state ne ST_BQUOTE) {
- $plain_buffer =~ s/\s+/ /g;
- $plain_buffer =~ s/^\s+//s;
- }
-
- $plain_buffer =~ s/\s+$//s;
-
- if (($output_type eq 'html') || ($flush_state ne ST_BQUOTE)) {
- print &filter_text($plain_buffer), "\n";
- }
- else {
- print $plain_buffer, "\n";
- }
-
- $plain_buffer = '';
- }
-}
-
-sub START () { 'begin' }
-sub CEASE () { 'cease' }
-sub MAINT () { 'maint' }
-sub TWEEN () { 'tween' }
-
-my %formats =
-( 'html' =>
- { &CEASE =>
- { &ST_BQUOTE => sub { "</pre></p>\n" },
- &ST_PLAIN => sub { "</p>\n" },
- &ST_PARAGRAPH => sub { "" },
- &ST_ENUMLIST => sub { "</ol>\n" },
- &ST_BULLETLIST => sub { "</ol>\n" },
- &ST_DOCUMENT => sub { "</p>\n<hr>\n" .
- "<font size=-1>Generated by out-out on " .
- scalar(gmtime) . " GMT.</font>\n" .
- "</body>\n</html>"
- },
- },
- &START =>
- { &ST_PARAGRAPH => sub { "" },
- &ST_PLAIN => sub { "<p>\n" },
- &ST_BQUOTE => sub { "<p><pre>\n" },
- &ST_ENUMLIST => sub { "<ol type=1>\n<li>" },
- &ST_BULLETLIST => sub { "<ul type=disc>\n<li>" },
- &ST_DOCUMENT => sub { "<html>\n<head>\n<title>" . $_[0] .
- "</title>\n</head>\n<body>\n" .
- "<h1>" . $_[0] . "</h1>\n"
- },
- &ST_SECTION => sub { "<hr>\n<h1>$_[0]</h1>\n" },
- &ST_HEADING => sub { "<ol type=" . $html_head[$_[1]]->[0] . ">\n" },
- },
- &TWEEN =>
- { &ST_ENUMLIST => sub { &flush_text($state); "<li>"; },
- &ST_BULLETLIST => sub { &flush_text($state); "<li>"; },
- &ST_HEADING => sub { "<font size=" . $html_head[$_[1]]->[1] . ">" .
- "<li>" . $_[0] . "</font>\n"
- },
- }
- },
- 'pod' =>
- { &CEASE =>
- { &ST_BQUOTE => sub { "\n" },
- &ST_PLAIN => sub { "\n" },
- &ST_PARAGRAPH => sub { "" },
- &ST_ENUMLIST => sub { pop @list_counts; "\n=back\n\n" },
- &ST_BULLETLIST => sub { "\n=back\n\n" },
- &ST_DOCUMENT => sub { "=cut\n" },
- },
- &START =>
- { &ST_PARAGRAPH => sub { "" },
- &ST_PLAIN => sub { "" },
- &ST_BQUOTE => sub { "" },
- &ST_ENUMLIST => sub { push(@list_counts, 1);
- "=over 2\n\n=item " . $list_counts[-1]++ . ' '
- },
- &ST_BULLETLIST => sub { "=over 2\n\n=item * " },
- &ST_DOCUMENT => sub { "\n=head1 $_[0]\n\n" },
- &ST_SECTION => sub { "=head1 $_[0]\n\n" },
- &ST_HEADING => sub { push(@list_counts, 1);
- "=over 2\n\n"
- },
- },
- &TWEEN =>
- { &ST_ENUMLIST => sub { &flush_text($state);
- "\n=item " . $list_counts[-1]++ . ' ';
- },
- &ST_BULLETLIST => sub { &flush_text($state); "\n=item * "; },
- &ST_HEADING => sub { "=item " . $list_counts[-1]++ .
- " $_[0]\n\n"
- },
-# &ST_HEADING => sub { "=item " . ($_[1]+1) . " $_[0]\n\n" },
- }
- }
-);
-
-sub format {
- my $mode = shift;
- my $format = shift;
- my $text = &filter_text(shift);
- print &{$formats{$output_type}->{$mode}->{$format}}($text, @_);
-}
-
-sub format_outline {
- my $new_state = shift;
- my $text = shift;
-
- if (($new_state eq ST_HEADING) and ($text eq '')) {
- $new_state = ST_BACKOUT;
- }
-
- # state transition
- if ($new_state ne $state) {
-
- &flush_text($state);
-
- if ($state eq ST_BQUOTE) {
- &format(CEASE, ST_BQUOTE, $text);
- }
- elsif ($state eq ST_PLAIN) {
- &format(CEASE, ST_PLAIN, $text);
- }
- elsif ($state eq ST_PARAGRAPH) {
- &format(CEASE, ST_PARAGRAPH, $text);
- }
- elsif ($state eq ST_ENUMLIST) {
- &format(CEASE, ST_ENUMLIST, $text);
- }
- elsif ($state eq ST_BULLETLIST) {
- &format(CEASE, ST_BULLETLIST, $text);
- }
-
- if ($new_state eq ST_PARAGRAPH) {
- &format(START, ST_PARAGRAPH, $text);
- }
- elsif ($new_state eq ST_PLAIN) {
- &format(START, ST_PLAIN, $text);
- }
- elsif ($new_state eq ST_BQUOTE) {
- &format(START, ST_BQUOTE, $text);
- }
- elsif ($new_state eq ST_ENUMLIST) {
- &format(START, ST_ENUMLIST, $text);
- }
- elsif ($new_state eq ST_BULLETLIST) {
- &format(START, ST_BULLETLIST, $text);
- }
- }
- # maintain the current state
- else {
- if ($state eq ST_ENUMLIST) {
- &format(TWEEN, ST_ENUMLIST, $text);
- }
- elsif ($state eq ST_BULLETLIST) {
- &format(TWEEN, ST_BULLETLIST, $text);
- }
- }
- # things regardless of transition
- if ($new_state eq ST_HEADING) {
- my ($index) = @_;
-
- if ($index - $last_index > 1) {
- die "outline level changes by more than +1 at input line $.\n";
- }
-
- if ($index < $last_index) {
- my $pop_index = $last_index;
- do {
- &format(CEASE, ST_ENUMLIST, $text);
- $pop_index--;
- } until ($index == $pop_index);
- }
-
- if ($index == 0) {
- if ($last_index == 0) {
- &format(START, ST_DOCUMENT, $text);
- }
- else {
- &format(START, ST_SECTION, $text);
- }
- }
- else {
- if ($index > $last_index) {
- &format(START, ST_HEADING, $text, $index);
- }
- &format(TWEEN, ST_HEADING, $text, $index);
- }
-
- $last_index = $index;
- }
-
- elsif ($new_state eq ST_BACKOUT) {
- my $new_index = $_[0];
- my $pop_count = $last_index - $new_index;
- if ($pop_count < 1) {
- die "can't back out $pop_count levels at input line $.\n";
- }
-
- &format(CEASE, ST_ENUMLIST, $text) while ($pop_count--);
-
- if ($new_index == 0) {
- if ($last_index == 0) {
- die "$0 should never reach the code";
- }
- else {
- &format(START, ST_SECTION, $text);
- }
- }
- else {
- &format(START, ST_PARAGRAPH, $text, $new_index);
- }
-
- $last_index = $new_index;
- }
-
- elsif ($new_state eq ST_EOF) {
- while ($last_index--) {
- &format(CEASE, ST_ENUMLIST, $text);
- }
- &format(CEASE, ST_DOCUMENT, $text);
- }
- elsif ($new_state ne ST_PARAGRAPH) {
- $plain_buffer .= $text . "\n";
- }
-
- $state = $new_state;
-}
-
-while (<>) {
- 1 while (chomp());
-
- if (s/^(\*+)\s*//) {
- &format_outline(ST_HEADING, $_, length($1)-1);
- }
- elsif ($_ eq '') {
- &format_outline(ST_PARAGRAPH, $_);
- }
- elsif (/^\s/) {
- &format_outline(ST_BQUOTE, $_);
- }
- elsif (s/^\#\)\s+//) {
- &format_outline(ST_ENUMLIST, $_);
- }
- elsif (s/^o\)\s+//) {
- &format_outline(ST_BULLETLIST, $_);
- }
- else {
- &format_outline(ST_PLAIN, $_);
- }
-}
-
-&format_outline(ST_EOF, '');
-
-__END__
-
-out-out pod POE-outline > POE.pod
-out-out html POE-outline > POE.html
-pod2html POE.pod > POE.pod.html
View
3 poe/examples/README.samples
@@ -1,3 +0,0 @@
-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.
View
229 poe/examples/create.perl
@@ -1,229 +0,0 @@
-#!/usr/bin/perl -w
-# $Id$
-
-# 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;
View
177 poe/examples/fakelogin.perl
@@ -1,177 +0,0 @@
-#!/usr/bin/perl -w
-# $Id$
-
-# 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__
View
186 poe/examples/forkbomb.perl
@@ -1,186 +0,0 @@
-#!/usr/bin/perl -w -I..
-# $Id$
-
-# 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;
View
323 poe/examples/names.perl
@@ -1,323 +0,0 @@
-#!/usr/bin/perl -w
-# $Id$
-
-# 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;
View
143 poe/examples/objmaps.perl
@@ -1,143 +0,0 @@
-#!/usr/bin/perl -w
-# $Id$
-
-# 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;
View
137 poe/examples/objsessions.perl
@@ -1,137 +0,0 @@
-#!/usr/bin/perl -w
-# $Id$
-
-# 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.