--- /dev/null
+use strict;
+use warnings ;
+
+use Config;
+use File::Spec;
+
+use BuildStem ;
+
+my $is_win32 = ( $^O =~ /Win32/) ? 1 : 0 ;
+
+my %requires ;
+
+my $version_from = File::Spec->catfile( File::Spec->curdir, 'lib', 'Stem.pm' );
+
+my $build = BuildStem->new(
+ module_name => 'Stem',
+ dist_version_from => $version_from,
+ requires => \%requires,
+ license => 'gpl',
+ dynamic_config => 1,
+ recursive_test_files => 1,
+ create_makefile_pl => 'passthrough'
+);
+
+# since we are making a fresh Build script, delete any older stem config file
+# so Build will create a new one.
+
+my $conf_pm_file = $build->config_pm_path() ;
+unlink $conf_pm_file ;
+
+$build->create_build_script() ;
+
+exit ;
--- /dev/null
+package BuildStem ;
+
+use strict;
+use warnings qw( all );
+
+use Carp ;
+use Config;
+use File::Path ;
+use File::Spec ;
+
+use lib 'lib' ;
+use base 'Module::Build' ;
+
+$ENV{HARNESS_DEBUG} = 1 ;
+$ENV{HARNESS_VERBOSE} = 1 ;
+
+# this is the common env values to control running stem stuff in the
+# build directory.
+
+my $env =
+ 'PATH=blib/bin:blib/demo:$PATH PERL5LIB=blib/lib STEM_CONF_PATH=conf' ;
+
+my %env = (
+ PATH => "blib/bin:blib/demo:$ENV{PATH}",
+ PERL5LIB => 'blib/lib',
+ STEM_CONF_PATH => 'conf',
+) ;
+
+local( @ENV{ keys %env } ) = values %env ;
+
+
+my ( @manifest_lines ) ;
+
+eval {
+ require Stem::InstallConfig
+} ;
+my $conf = \%Stem::InstallConfig::Config ;
+
+my $is_win32 = ( $^O =~ /Win32/) ? 1 : 0 ;
+
+my $default_stem_path = $is_win32 ?
+ '/stem' :
+ File::Spec->catfile(
+ File::Spec->rootdir, qw( usr local stem ) ) ;
+
+my $default_conf_path = File::Spec->catfile( $default_stem_path, 'conf' ) ;
+#my $default_tail_dir = File::Spec->catfile( File::Spec->tmpdir, 'stem_tail' );
+
+my %defaults = (
+ bin_path => $Config{bin},
+ run_stem_path => File::Spec->catfile( $Config{bin}, 'run_stem' ),
+ perl_path => $Config{perlpath},
+ conf_path => $default_conf_path,
+ prefix => $Config{prefix},
+# tail_dir => $default_tail_dir,
+ build_demos => ! $is_win32,
+ install_demos => ! $is_win32,
+ install_ssfe => ! $is_win32,
+ %{$conf}
+);
+
+################
+# these are the top level action handlers. ACTION_foo gets called when you do
+# 'Build foo' on the command line
+################
+
+sub ACTION_build {
+
+ my ( $self ) = @_ ;
+
+ $self->query_for_config() ;
+
+ $self->SUPER::ACTION_build() ;
+
+# $self->build_bin() ;
+}
+
+sub ACTION_test {
+
+ my ( $self ) = @_ ;
+
+ local( @ENV{ keys %env } ) = values %env ;
+
+ $self->depends_on('build');
+
+ $self->SUPER::ACTION_test() ;
+}
+
+sub ACTION_install {
+
+ my ( $self ) = @_ ;
+
+ $self->install_config_files() ;
+# $self->install_ssfe() ;
+
+ $self->SUPER::ACTION_install() ;
+}
+
+sub ACTION_run {
+
+ my ( $self ) = @_ ;
+
+ $self->depends_on('build');
+
+ my $run_cmd = $self->{'args'}{'cmd'} || '' ;
+
+ $run_cmd or die "Missing cmd=name argument" ;
+
+ my $cmd = "$env $run_cmd" ;
+# print "CMD: $cmd\n" ;
+
+ system $cmd ;
+}
+
+sub ACTION_run_stem {
+
+ my ( $self ) = @_ ;
+
+ $self->depends_on('build');
+
+ my $conf = $self->{'args'}{'conf'} || '' ;
+
+ $conf or die "Missing conf=name argument" ;
+
+ my $cmd = "$env run_stem $conf" ;
+# print "DEMO: $cmd\n" ;
+
+ system $cmd ;
+}
+
+
+sub run_demo {
+
+ my ( $self ) = @_ ;
+
+ $self->depends_on('build');
+
+ my $cmd = "$env $self->{action}_demo" ;
+ print "DEMO: $cmd\n" ;
+ system $cmd ;
+}
+
+
+sub ACTION_tail {
+
+ mkdir 'tail' ;
+
+ unlink <tail/*> ;
+
+ goto &run_demo ;
+}
+
+*ACTION_chat = \&run_demo ;
+*ACTION_chat2 = \&run_demo ;
+*ACTION_inetd = \&run_demo ;
+
+sub ACTION_update_pod {
+
+ my( $self ) = @_ ;
+
+ my @manifest_sublist = $self->grep_manifest( qr/\.pm$/ ) ;
+
+ @manifest_sublist = grep /Codec/, @manifest_sublist ;
+
+print join( "\n", @manifest_sublist ), "\n" ;
+
+ system( "bin/spec2pod.pl @manifest_sublist" ) ;
+
+ return;
+}
+
+# grep through all matched files
+# command line args:
+# files=<regex> (default is all .pm files)
+# re=<regex>
+
+sub ACTION_grep {
+
+ my( $self ) = @_ ;
+
+ my $args = $self->{'args'} ;
+
+ my $file_regex = $args->{ files } || qr/\.pm$/ ;
+ my $grep_regex = $args->{ re } or die "need grep regex" ;
+
+ my @manifest_sublist = $self->grep_manifest( $file_regex ) ;
+
+ local( @ARGV ) = @manifest_sublist ;
+
+ while( <> ) {
+
+ next unless /$grep_regex/ ;
+
+ print "$ARGV:$. $_"
+ }
+ continue {
+
+ close ARGV if eof ;
+ }
+
+ return;
+}
+
+# ACTION: grep through MANIFEST
+# command line args:
+# files=<regex>
+#
+# do we need this action?
+#
+
+sub ACTION_grep_manifest {
+
+ my( $self ) = @_ ;
+
+ my @manifest_sublist = $self->grep_manifest() ;
+
+ print join( "\n", @manifest_sublist ), "\n" ;
+ return;
+}
+
+# ACTION: count source lines
+# command line args:
+# files=<regex> (defaults to all .pm and bin files
+#
+# do we need this action?
+
+sub ACTION_lines {
+
+ my( $self ) = @_ ;
+
+ my $args = $self->{'args'} ;
+ my $file_regex = $args->{ files } || qr/\.pm$|^bin/ ;
+
+ my @manifest_sublist = $self->grep_manifest( $file_regex ) ;
+
+ system( "./util/lines @manifest_sublist" ) ;
+
+ return;
+}
+
+# build a distro and scp to stemsystems.com
+
+sub ACTION_ftp {
+
+ my ( $self ) = @_ ;
+
+ my $dist_tar = $self->dist_dir() . '.tar.gz' ;
+
+ unlink $dist_tar ;
+
+ $self->ACTION_dist() ;
+
+ system "scp $dist_tar stemsystems.com:www/" ;
+}
+
+
+# this sub overrides the find_test_files method in Module::Build
+
+sub find_test_files {
+
+ my ($self) = @_;
+
+ my $test_args = $self->{ args }{ tests } ;
+
+ my @tests = $test_args ? split( ':', $test_args ) :
+ $self->grep_manifest( qr/\.t$/ ) ;
+
+ return \@tests ;
+}
+
+sub process_script_files {
+ my( $self ) = @_ ;
+
+ my @scripts = $self->grep_manifest( qr{^bin/} ) ;
+
+#print "SCR @scripts\n" ;
+ foreach my $file ( @scripts ) {
+
+ my $bin_dir = File::Spec->catdir(
+ $self->blib,
+ $file =~ /_demo$/ ? 'demo' : 'bin' ) ;
+
+ File::Path::mkpath( $bin_dir );
+
+ my $result = $self->copy_if_modified(
+ $file, $bin_dir, 'flatten') or next;
+
+#print "COPY $file\n" ;
+ $self->fix_run_stem($result);
+ $self->fix_demos($result);
+ $self->fix_shebang_line($result);
+ $self->make_executable($result);
+ }
+}
+
+sub fix_run_stem {
+
+ my( $self, $file ) = @_ ;
+
+ return unless $file =~ m{/run_stem$} ;
+
+ my $text = read_file( $file ) ;
+
+ $text =~ s/'conf:.'/'$conf->{'conf_path'}'/ if $conf->{'conf_path'} ;
+
+ write_file( $file, $text ) ;
+}
+
+sub fix_demos {
+
+ my( $self, $file ) = @_ ;
+
+ return unless $file =~ /_demo$/ ;
+
+ my $text = read_file( $file ) ;
+
+ $conf->{xterm_path} ||= 'NOT FOUND' ;
+ $conf->{telnet_path} ||= 'NOT FOUND' ;
+
+ $text =~ s[xterm][$conf->{xterm_path}]g;
+ $text =~ s[telnet][$conf->{telnet_path}]g;
+
+ write_file( $file, $text ) ;
+}
+
+# MANIFEST helper subs
+
+sub grep_manifest {
+
+ my( $self, $file_regex ) = @_ ;
+
+ $file_regex ||= $self->{ args }{ files } || qr/.*/ ;
+
+ manifest_load() ;
+
+ return grep( /$file_regex/, @manifest_lines ) ;
+}
+
+sub manifest_load {
+
+ return if @manifest_lines ;
+
+ @manifest_lines = grep ! /^\s*$|^\s*#/, read_file( 'MANIFEST' ) ;
+
+ chomp @manifest_lines ;
+
+ return ;
+}
+
+#################################
+
+sub query_for_config {
+
+ my( $self ) = @_ ;
+
+ return if $defaults{ 'config_done' } ;
+
+ print <<'EOT';
+
+Building Stem
+
+This script will ask you various questions in order to properly
+configure, build and install Stem on your system. Whenever a question
+is asked, the default answer will be shown inside [brackets].
+Pressing enter will accept the default answer. If a choice needs to be
+made from a list of values, that list will be inside (parentheses).
+
+If you have already configured Stem in a previous build, you can put
+use_defaults=1 on the Build command line and you won't be prompted for
+any answers and the previous settings will be used.
+
+If you want to force a new build, run Build clean.
+
+EOT
+
+ $self->get_path_config() ;
+ $self->get_demo_config() ;
+
+ $defaults{ 'config_done' } = 1 ;
+
+ $self->write_config_pm() ;
+}
+
+
+my $package = 'Stem::InstallConfig' ;
+
+sub config_pm_path {
+
+ return File::Spec->catfile(
+ File::Spec->curdir, 'lib', split( /::/, $package) ) . '.pm' ;
+
+}
+
+sub write_config_pm {
+
+ my ( $self ) = @_ ;
+
+ my $config = Data::Dumper->Dump(
+ [\%defaults],
+ ["*${package}::Config"]
+ );
+
+ my $conf_pm_file = $self->config_pm_path() ;
+
+ $self->add_to_cleanup( $conf_pm_file ) ;
+
+ write_file( $conf_pm_file, <<EOT ) ;
+
+# DO NOT EDIT
+# this file is generated by running Build build
+
+package $package ;
+
+$config
+1 ;
+EOT
+
+}
+
+
+sub get_path_config {
+
+ my( $self ) = @_ ;
+
+# $self->query_config_value( <<'EOT', 'perl_path' );
+
+# Stem has several executable Perl programs and demonstration scripts
+# and they need to have the correct path to your perl binary.
+
+# What is the path to perl?
+# EOT
+
+# $self->query_config_value( <<'EOT', 'bin_path' );
+
+# Those Stem executables need to be installed in a directory that is in your
+# shell $PATH variable.
+
+# What directory will have the Stem executables?
+# EOT
+
+ $self->query_config_value( <<'EOT', 'conf_path' );
+
+Stem configuration files are used to create and initialize Stem Cells
+(objects). Stem needs to know the list of directories to search to
+find its configurations files.
+
+Note that the default has a single absolute path. You can test Stem
+configurations easily setting this path when executing run_stem. You
+can override or modify the path time with either a shell environment
+variable or on the command line of run_stem. See the documentation on
+run_stem for how so do this.
+
+The first directory in the list is where the standard Stem
+configuration files will be installed.
+
+Enter a list of absolute directory paths separated by ':'.
+
+What directories do you want to search for Stem configuration files?
+EOT
+
+ return ;
+}
+
+sub get_demo_config {
+
+ my( $self ) = @_ ;
+
+# don't even bother if win32
+
+ return if $is_win32 ;
+
+# $self->get_config_boolean( <<'EOT', 'build_demos' );
+
+# Stem comes with several demonstration scripts. After building them,
+# they can be run from the main directory by the Build script: ./Build
+# chat, Build inetd, etc. Do you want to build the demos?
+# EOT
+
+# return unless $defaults{build_demos};
+
+# all the demos need xterm
+
+ $self->get_xterm_path();
+ $self->get_telnet_path();
+ return unless -x $defaults{xterm_path} && -x $defaults{telnet_path};
+
+# $self->query_config_value( <<'EOT', 'tail_dir' );
+
+# The tail demo script needs a temporary working directory. Enter the
+# path to a directory to use for this purpose. If it does not exist,
+# this directory will be created.
+# EOT
+
+ $self->get_config_boolean( <<'EOT', 'install_ssfe' );
+
+ssfe (Split Screen Front End) is a compiled program optionally used by
+the Stem demonstration scripts that provides a full screen interface
+with command line editing and history. It is not required to run Stem
+but it makes the demonstrations easier to work with and they look much
+nicer. To use ssfe add the '-s' option when you run any demonstration
+script. You can also use ssfe for your own programs. Install ssfe in
+some place in your \$PATH ($conf->{'bin_path'} is where Stem executables
+are being installed) so it can be used by the demo scripts. The ssfe
+install script will do this for you or you can do it manually after
+building it.
+
+Do you want to install ssfe?
+EOT
+
+}
+
+sub get_xterm_path {
+
+ my( $self ) = @_ ;
+
+ my $xterm_path;
+
+# unless ( $xterm_path = which_exec( 'xterm' ) ) {
+
+# foreach my $path ( qw(
+# /usr/openwin/bin/xterm
+# /usr/bin/X11/xterm
+# /usr/X11R6/bin/xterm ) ) {
+
+# next unless -x $path;
+# $xterm_path = $path ;
+# last;
+# }
+# }
+
+# if ( $xterm_path ) {
+
+# $defaults{'xterm_path'} = $xterm_path ;
+# print "xterm was found at '$xterm_path'\n";
+# return ;
+# }
+
+ $self->query_config_value( <<"EOT", 'xterm_path' );
+
+xterm was not found on this system. you can't run the demo programs
+without xterm. Make sure you enter a valid path to xterm or some other
+terminal emulator.
+
+NOTE: If you don't have an xterm, you can still run the demo scripts
+by hand. Run a *_demo script and see what commands it issues. Take the
+part after the -e and run that command in its own terminal window.
+
+Enter the path to xterm (or another compatible terminal emulator)
+EOT
+
+}
+
+sub get_telnet_path {
+
+ my( $self ) = @_ ;
+
+ my $telnet_path;
+
+ unless ( $telnet_path = which_exec( 'telnet' ) ) {
+
+# enter a list of common places to find telnet. or delete this as it
+# will almost always be in the path
+
+ foreach my $path ( qw( ) ) {
+
+ next unless -x $path;
+ $telnet_path = $path ;
+ last;
+ }
+ }
+
+ if ( $telnet_path ) {
+
+ $defaults{'telnet_path'} = $telnet_path ;
+ print "telnet was found at '$telnet_path'\n";
+ return ;
+ }
+
+ $self->query_config_value( <<"EOT", 'telnet_path' );
+
+telnet was not found on this system. you can't run the demo programs
+without telnet. Make sure you enter a valid path to telnet or some other
+terminal emulator.
+
+NOTE: If you don't have an telnet, you can still run the demo scripts
+by hand. Run a *_demo script and see what telnet commands it
+issues. The run those telnet commands using your telnet or another
+similar program.
+
+Enter the path to telnet (or another compatible terminal emulator)
+EOT
+
+}
+
+sub install_config_files {
+
+ my ( $self ) = @_ ;
+
+ my ( $conf_path ) = split /:/, $conf->{conf_path} ;
+
+ mkpath( $conf_path, 1, 0755 ) unless -d $conf_path ;
+
+ my @config_files = $self->grep_manifest( qr{^conf/.+\.stem$} ) ;
+
+ foreach my $conf_file (@config_files) {
+
+ $conf_file =~ s{conf/}{} ;
+
+ my $out_file = File::Spec->catfile( $conf_path, $conf_file );
+
+ print "Installing config file: $out_file\n";
+
+ my $in_file = File::Spec->catfile(
+ File::Spec->curdir(), 'conf', $conf_file );
+
+ my $conf_text = read_file($in_file);
+
+ if ( $conf_file eq 'inetd.stem' ) {
+
+ my $quote_serve = File::Spec->catfile(
+ $conf->{bin_path}, 'quote_serve' );
+
+ $conf_text =~ s[path\s+=>\s+'bin/quote_serve',]
+ [path\t\t=> '$quote_serve',];
+ }
+# elsif ( $conf eq 'monitor.stem' || $conf eq 'archive.stem' ) {
+
+# $conf_text =~ s[path'\s+=>\s+'tail]
+# [path'\t\t=> '$conf->{tail_dir}]g ;
+# }
+
+ write_file( $out_file, $conf_text );
+ }
+}
+
+
+sub install_ssfe {
+
+ my ( $self ) = @_ ;
+
+ return unless $conf->{install_stem_demos} &&
+ $conf->{install_ssfe} ;
+
+ print <<'EOT';
+
+Installing ssfe.
+
+This is not a Stem install script and it will ask its own
+questions. It will execute in its own xterm (whatever was configured
+earlier) to keep this install's output clean. The xterm is kept open
+with a long sleep call and can be exited by typing ^C.
+
+EOT
+
+#########
+# UGLY
+#########
+
+ system <<'EOT';
+xterm -e /bin/sh -c 'chdir extras ;
+tar zxvf sirc-2.211.tar.gz ;
+chdir sirc-2.211 ;
+./install ;
+sleep 1000 ;'
+EOT
+
+ print "\nInstallation of ssfe is done\n\n";
+}
+
+#########################################################
+# this sub builds the exec scripts in bin and puts them into blib/bin
+# for local running or later installation
+
+# sub build_bin {
+
+# my ( $self ) = @_ ;
+
+# my @bin_scripts = $self->grep_manifest( qr{^bin/} ) ;
+
+# foreach my $bin_file ( @bin_scripts ) {
+
+# #print "BIN $bin_file\n" ;
+
+# my $bin_text = read_file( $bin_file ) ;
+
+# $bin_file =~ s{bin/}{} ;
+
+# # fix the shebang line
+
+# $bin_text =~ s{/usr/local/bin/perl}{$conf->{'perl_path'}} ;
+
+# my $bin_dir ;
+
+# if ( $bin_file =~ /_demo$/ ) {
+
+# next unless $conf->{build_demos} ;
+
+# $bin_dir = 'demo' ;
+
+# # fix the location of xterms in the demo scripts
+
+# $bin_text =~ s[xterm][$conf->{xterm_path}]g;
+# $bin_text =~ s[telnet][$conf->{telnet_path}]g;
+
+# # fix the default config search path in run_stem
+# }
+# else {
+
+# $bin_dir = 'bin' ;
+
+# # fix the default config search path in run_stem
+
+# if ( $bin_file eq 'run_stem' ) {
+# $bin_text =~
+# s/'conf:.'/'$conf->{'conf_path'}'/ ;
+# }
+# }
+
+# # elsif ( $bin_file eq 'tail_demo' ) {
+# # $bin_text =~ s['tail']['$conf->{tail_dir}'];
+# # }
+
+# # write the built script into the blib/ dir
+
+# my $out_file = File::Spec->catfile( 'blib',
+# $bin_dir,
+# $bin_file
+# );
+
+# mkdir "blib/$bin_dir" ;
+# print "Building executable script: $out_file\n";
+# write_file( $out_file, $bin_text );
+# chmod 0755, $out_file;
+# }
+# }
+
+#############################################################
+
+# this sub searches the path for the locations of an executable
+
+sub which_exec {
+
+ my ( $exec ) = @_;
+
+ foreach my $path_dir ( split /[:;]/, $ENV{PATH} ) {
+
+ my $exec_path = File::Spec->catfile( $path_dir, $exec );
+ return $exec_path if -x $exec_path ;
+ }
+
+ return;
+}
+
+# the sub searches a list of dir paths to find the first one that
+# exists with a prefix dir
+
+# UNUSED FOR THE MOMENT
+
+# sub which_dir {
+
+# my ( $prefix, @dirs ) = @_;
+
+# foreach my $subdir ( @dirs ) {
+
+# my $dir = File::Spec->catfile( $prefix, $subdir );
+# return $dir if -x $dir;
+# }
+
+# return;
+# }
+
+#############################################################
+
+# these subs handle querying for a user answer. it uses the key to
+# find a current value in the defaults and prompt for another value
+# if 'use_defaults' is set on the command line, then no prompting will be done
+
+sub query_config_value {
+
+ my( $self, $query, $key ) = @_ ;
+
+ my $default = $self->{args}{$key} ;
+
+ $default = $defaults{ $key } unless defined $default ;
+
+ $defaults{ $key } = ( $self->{args}{use_defaults} ) ?
+ $default :
+ $self->prompt( edit_query( $query, $default ), $default ) ;
+}
+
+sub get_config_boolean {
+
+ my( $self, $query, $key ) = @_ ;
+
+ my $default = $self->{args}{$key} ;
+
+ $default = $defaults{ $key } unless defined $default ;
+ $default =~ tr/01/ny/ ;
+
+ $defaults{ $key } = ( $self->{args}{use_defaults} ) ?
+ $default :
+ $self->y_n( edit_query( $query, $default ), $default ) ;
+}
+
+sub edit_query {
+
+ my ( $query, $default ) = @_ ;
+
+ chomp $query ;
+
+ $default ||= '' ;
+
+ my $last_line = (split /\n/, $query)[-1] ;
+
+ if ( length( $last_line ) + 2 * length( $default ) > 70 ) {
+
+ $query .= "\n\t" ;
+ }
+
+ return $query ;
+}
+
+# low level file i/o subs. should be replaced with File::Slurp. stem
+# should depend on it
+
+
+sub read_file {
+
+ my ( $file_name ) = @_ ;
+
+ local( *FH );
+
+ open( FH, $file_name ) || croak "Can't open $file_name $!";
+
+ return <FH> if wantarray;
+
+ read FH, my $buf, -s FH;
+ return $buf;
+}
+
+sub write_file {
+
+ my( $file_name ) = shift ;
+
+ local( *FH ) ;
+
+ open( FH, ">$file_name" ) || croak "can't create $file_name $!" ;
+
+ print FH @_ ;
+}
+
+1 ;
--- /dev/null
+Stem Version 0.11
+=================
+Fri Dec 1 03:50:58 EST 2006
+
+
+* The Stem event loop is layered and can easily wrap other event
+ loops. Supported event loops include Event.pm, perl/tk and wxperl and
+ a pure Perl event Loop. See Stem::Event.pm and Stem::Event::EventPM.pm
+ for more. Other event loops that need wrapping include POE, Gtk and Qt.
+
+* There is a pure Perl event Loop so Stem now runs on windows or on any
+ system where Event.pm isn't installed.
+
+* Full support for SSL on all socket related objects and cells.
+ Converting from a plain socket to an SSL socket just requires adding
+ the SSL arguments to the Stem::Socket contruction. All Stem modules
+ that use sockets use Stem::Socket which in turn uses IO::Socket::SSL
+ (and that needs openssl). If that module is not installed, its test
+ will be skipped.
+
+* There is a Stem::UDPMsg cell that provides a UDP socket client and/or
+ server.
+
+* The new Stem::Cell::Flow module provides a way for Stem cells to
+ handle a mix of sync/async (local/remote) method calls. You can create
+ a logic flow with if/else/while command in a simple mini-language.
+ This allows a cell to do complex operations such as accessing a DB
+ (via Stem::DBI) or fetching web pages and mix that with local method
+ calls that crunch the data. Normally this would entail a complex state
+ machine or having each method know the next one to call but
+ Stem::Cell::Flow allows you to convert that to a much simpler logic
+ flow. See the test script t/cell/flow.t and the lib/Stem/Test/Flow.pm
+ module for more on this. It requires Parse::RecDescent to be installed
+ (the test will be skipped if it is not found).
+
+* A bunch of new tests were added:
+
+ Event loops
+ Sockets (both with and without SSL)
+ Stem::Cell::Flow
+
+* There is a brand new install based on Module::Build. A Makefile.PL is
+ provided but it is a wrapper around the Module::Build installer. Stem
+ can now be installed with CPAN.pm
+
+* There is more pod (and more is needed). All contructor attributes are
+ now automatically updated to pod by the stem2pod utility. That script
+ also inserts pod templates for all methods. This will make it easier
+ to add pod and keep it up to date.
+
+* Cleaned up the INSTALL, README and other top level documents.
+
+* Many more changes than I have room to write in this file.
+
+Stem Version 0.10
+=================
+Nov-11-2002
+
+* The version number has been bumped to 0.10 because of the large number
+ of changes and the major improvements in reliability and speed.
+
+* Renamed Stem::TtyMsg to Stem::Console. Now it doesn't need any
+ arguments to be initialized. A Stem envioronment variable can be set
+ which will disable it. All the configuration files and demo scripts
+ have been updated to use it. The old TtyMsg module has been deleted.
+
+* Added Stem::Test::Echo.pm and Stem::Load::Driver.pm. They support
+ benchmarking of basic message passing in multiple modes.
+
+* Stem::Msg now only accepts the string format of message
+ addresses. This speeds up message creation and simplifies message
+ handling and delivery.
+
+* Stem::Class now supports attribute type checking and
+ conversion. Supported types include boolean, list, hash, LoL (and
+ friends), object and handle.
+
+* Stem::Conf has better error reporting. The Cell name and class are now
+ printed with the error.
+
+* Added the reply_type field to messages. This is used to make simple
+ state machines with messages (used in the work sequencing system).
+
+* Stem::Portal has been improved and now use the Stem::Packet module to
+ handle its buffering.
+
+* Added Stem::Packet and Stem::Codec::*. These modules support
+ serializing (marshalling) Stem data for use in pipes and files. The
+ codec to be used can be selected in the configuration file. This is
+ now used in Stem::Portal and all worker mode operations. Current codec
+ include Perl (Data::Dumper/eval), YAML, and Storable.
+
+* Split Log.pm into Log.pm and Log/Entry.pm. Moved Stem::LogTail.pm to
+ Stem::Log::Tail.pm. Added Stem::Log::File which handles physical log
+ files including rotation and archiving.
+
+* Added Stem::Trace.pm which gives modules a simple way to inject log
+ entries during program execution. It allows for creation of customized
+ Trace functions which can have defaults and different calling styles.
+
+* Split Stem::Cell.pm into multiple files to make it easier to
+ maintain. These include Stem::Cell::Sequence.pm, Stem::Cell::Clone.pm,
+ Stem::Cell::Pipe.pm and Stem::Cell::Work.pm
+
+* Added the Stem::DBI module which is a Stem message based front end to
+ DBI. This Cell can be configured with the all the SQL needed for your
+ application which is shared by all the Cells that use it. It can be
+ run in its own Stem Hub (process) thereby providing non-blocking
+ access to the DB from other Hubs. A farm of these proxies can be
+ created and managed by a WorkQueue Cell which will support parallel DB
+ access from one or more Hubs.
+
+* Added work sequencing support in Stem::Cell. This allows any Cell to
+ call local or remote methods and to manage their flow control. This is
+ an interim version that will be superseded by a new mini-language that
+ will be easier to code and will support more complex flow
+ (e.g. if/else/while). This is a very powerful feature that simplifies
+ complex state operations to simple flow control statements.
+
+* Added the Stem::WorkQueue module which allows a set of work request
+ messages to be distributed to a set of worker Cells. Modified
+ Stem::Cell to support a cell to request a new work message.
+
+* Created worker mode where an object (or data structure) gets
+ sent to a Cell via a message. The Cell can then write the object to a
+ socket or process or crunch it. The Cell then gets back the object
+ (presumably modified) and sends it back to the originator of the work
+ request. This is done in Stem::Cell and used in Stem::Proc,
+ Stem::Sock::Msg and Stem::DBI.
+
+* Created worker ready mode where a Cell can send out a message stating
+ it can receive a work message. Typically this will go to a WorkQueue
+ Cell. This message is sent out when the Cell starts up or after it
+ completes a previous work request.
+
+* Added Stem::Boot.pm which will run a set of external programs and
+ monitor them. Their output can be logged and they can be
+ restarted. Other options (for each program) include setting the
+ initial directory and which host to run it on (via ssh if desired).
+ The set of programs and options are loaded via a configuration file
+ specific to this module.
+
+* Added Stem::Inject.pm which has one method which will connect to
+ a Stem Hub and send it a single message. Then it will read back a
+ single message and return its data. This is meant to be used in Perl
+ programs that are not Stem driven and want to communicate with Stem
+ cells.
+
+* Updated the Stem Cell cookbook with more examples. It now shows how to
+ create class and object cells and also how to create cloneable Cells.
+
+Stem Version 0.06
+=================
+Feb-26-2002
+
+* Stem is now released under the GPL. If you want to use Stem in a
+ product that will be sold, contact us about acquiring a commercial
+ license.
+
+* A simple and easy to use installation script is now included. The
+ installation script allows you to have a Stem environment up and
+ running in a matter of minutes. Read the INSTALL document to learn how
+ to run this script.
+
+* There is a new set of cookbook documents with examples. These show
+ you how to develop new Stem Cells.
+
+* Complete documentation is now included for all demonstration
+ scripts included with Stem.
+
+* Stem Message Addresses can now be in a string form as well as the hash
+ form. This simplifies creating addresses in Stem configurations. All
+ the installed configurations now use this format. See the Address
+ design notes for more on this.
+
+* The Stem::Cell module has been added. It supports generic functionality for
+ Stem Cells, including cloning, asynchronous I/O, and pipes. It
+ currently is used by the Stem::Proc and Stem::SockMsg modules. All
+ future Cells that need those services can use this module.
+
+* The modules Stem::Proc and Stem::SockMsg have been rewritten to use
+ Stem::Cell. They are much shorter and simpler now that the common
+ Cell functions are handled by Stem::Cell.
+
+* A new module, Stem::Gather, has been added. It allows you to
+ synchronize multiple asynchronous events. It triggers a callback when
+ all of its required tokens have been 'gathered'.
+
+* Bug fixes and general system improvements.
--- /dev/null
+ GNU GENERAL PUBLIC LICENSE
+ Version 2, June 1991
+
+ Copyright (C) 1989, 1991 Free Software Foundation, Inc.
+ 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+ Preamble
+
+ The licenses for most software are designed to take away your
+freedom to share and change it. By contrast, the GNU General Public
+License is intended to guarantee your freedom to share and change free
+software--to make sure the software is free for all its users. This
+General Public License applies to most of the Free Software
+Foundation's software and to any other program whose authors commit to
+using it. (Some other Free Software Foundation software is covered by
+the GNU Library General Public License instead.) You can apply it to
+your programs, too.
+
+ When we speak of free software, we are referring to freedom, not
+price. Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+this service if you wish), that you receive source code or can get it
+if you want it, that you can change the software or use pieces of it
+in new free programs; and that you know you can do these things.
+
+ To protect your rights, we need to make restrictions that forbid
+anyone to deny you these rights or to ask you to surrender the rights.
+These restrictions translate to certain responsibilities for you if you
+distribute copies of the software, or if you modify it.
+
+ For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must give the recipients all the rights that
+you have. You must make sure that they, too, receive or can get the
+source code. And you must show them these terms so they know their
+rights.
+
+ We protect your rights with two steps: (1) copyright the software, and
+(2) offer you this license which gives you legal permission to copy,
+distribute and/or modify the software.
+
+ Also, for each author's protection and ours, we want to make certain
+that everyone understands that there is no warranty for this free
+software. If the software is modified by someone else and passed on, we
+want its recipients to know that what they have is not the original, so
+that any problems introduced by others will not reflect on the original
+authors' reputations.
+
+ Finally, any free program is threatened constantly by software
+patents. We wish to avoid the danger that redistributors of a free
+program will individually obtain patent licenses, in effect making the
+program proprietary. To prevent this, we have made it clear that any
+patent must be licensed for everyone's free use or not licensed at all.
+
+ The precise terms and conditions for copying, distribution and
+modification follow.
+\f
+ GNU GENERAL PUBLIC LICENSE
+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+ 0. This License applies to any program or other work which contains
+a notice placed by the copyright holder saying it may be distributed
+under the terms of this General Public License. The "Program", below,
+refers to any such program or work, and a "work based on the Program"
+means either the Program or any derivative work under copyright law:
+that is to say, a work containing the Program or a portion of it,
+either verbatim or with modifications and/or translated into another
+language. (Hereinafter, translation is included without limitation in
+the term "modification".) Each licensee is addressed as "you".
+
+Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope. The act of
+running the Program is not restricted, and the output from the Program
+is covered only if its contents constitute a work based on the
+Program (independent of having been made by running the Program).
+Whether that is true depends on what the Program does.
+
+ 1. You may copy and distribute verbatim copies of the Program's
+source code as you receive it, in any medium, provided that you
+conspicuously and appropriately publish on each copy an appropriate
+copyright notice and disclaimer of warranty; keep intact all the
+notices that refer to this License and to the absence of any warranty;
+and give any other recipients of the Program a copy of this License
+along with the Program.
+
+You may charge a fee for the physical act of transferring a copy, and
+you may at your option offer warranty protection in exchange for a fee.
+
+ 2. You may modify your copy or copies of the Program or any portion
+of it, thus forming a work based on the Program, and copy and
+distribute such modifications or work under the terms of Section 1
+above, provided that you also meet all of these conditions:
+
+ a) You must cause the modified files to carry prominent notices
+ stating that you changed the files and the date of any change.
+
+ b) You must cause any work that you distribute or publish, that in
+ whole or in part contains or is derived from the Program or any
+ part thereof, to be licensed as a whole at no charge to all third
+ parties under the terms of this License.
+
+ c) If the modified program normally reads commands interactively
+ when run, you must cause it, when started running for such
+ interactive use in the most ordinary way, to print or display an
+ announcement including an appropriate copyright notice and a
+ notice that there is no warranty (or else, saying that you provide
+ a warranty) and that users may redistribute the program under
+ these conditions, and telling the user how to view a copy of this
+ License. (Exception: if the Program itself is interactive but
+ does not normally print such an announcement, your work based on
+ the Program is not required to print an announcement.)
+\f
+These requirements apply to the modified work as a whole. If
+identifiable sections of that work are not derived from the Program,
+and can be reasonably considered independent and separate works in
+themselves, then this License, and its terms, do not apply to those
+sections when you distribute them as separate works. But when you
+distribute the same sections as part of a whole which is a work based
+on the Program, the distribution of the whole must be on the terms of
+this License, whose permissions for other licensees extend to the
+entire whole, and thus to each and every part regardless of who wrote it.
+
+Thus, it is not the intent of this section to claim rights or contest
+your rights to work written entirely by you; rather, the intent is to
+exercise the right to control the distribution of derivative or
+collective works based on the Program.
+
+In addition, mere aggregation of another work not based on the Program
+with the Program (or with a work based on the Program) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+ 3. You may copy and distribute the Program (or a work based on it,
+under Section 2) in object code or executable form under the terms of
+Sections 1 and 2 above provided that you also do one of the following:
+
+ a) Accompany it with the complete corresponding machine-readable
+ source code, which must be distributed under the terms of Sections
+ 1 and 2 above on a medium customarily used for software interchange; or,
+
+ b) Accompany it with a written offer, valid for at least three
+ years, to give any third party, for a charge no more than your
+ cost of physically performing source distribution, a complete
+ machine-readable copy of the corresponding source code, to be
+ distributed under the terms of Sections 1 and 2 above on a medium
+ customarily used for software interchange; or,
+
+ c) Accompany it with the information you received as to the offer
+ to distribute corresponding source code. (This alternative is
+ allowed only for noncommercial distribution and only if you
+ received the program in object code or executable form with such
+ an offer, in accord with Subsection b above.)
+
+The source code for a work means the preferred form of the work for
+making modifications to it. For an executable work, complete source
+code means all the source code for all modules it contains, plus any
+associated interface definition files, plus the scripts used to
+control compilation and installation of the executable. However, as a
+special exception, the source code distributed need not include
+anything that is normally distributed (in either source or binary
+form) with the major components (compiler, kernel, and so on) of the
+operating system on which the executable runs, unless that component
+itself accompanies the executable.
+
+If distribution of executable or object code is made by offering
+access to copy from a designated place, then offering equivalent
+access to copy the source code from the same place counts as
+distribution of the source code, even though third parties are not
+compelled to copy the source along with the object code.
+\f
+ 4. You may not copy, modify, sublicense, or distribute the Program
+except as expressly provided under this License. Any attempt
+otherwise to copy, modify, sublicense or distribute the Program is
+void, and will automatically terminate your rights under this License.
+However, parties who have received copies, or rights, from you under
+this License will not have their licenses terminated so long as such
+parties remain in full compliance.
+
+ 5. You are not required to accept this License, since you have not
+signed it. However, nothing else grants you permission to modify or
+distribute the Program or its derivative works. These actions are
+prohibited by law if you do not accept this License. Therefore, by
+modifying or distributing the Program (or any work based on the
+Program), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Program or works based on it.
+
+ 6. Each time you redistribute the Program (or any work based on the
+Program), the recipient automatically receives a license from the
+original licensor to copy, distribute or modify the Program subject to
+these terms and conditions. You may not impose any further
+restrictions on the recipients' exercise of the rights granted herein.
+You are not responsible for enforcing compliance by third parties to
+this License.
+
+ 7. If, as a consequence of a court judgment or allegation of patent
+infringement or for any other reason (not limited to patent issues),
+conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License. If you cannot
+distribute so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you
+may not distribute the Program at all. For example, if a patent
+license would not permit royalty-free redistribution of the Program by
+all those who receive copies directly or indirectly through you, then
+the only way you could satisfy both it and this License would be to
+refrain entirely from distribution of the Program.
+
+If any portion of this section is held invalid or unenforceable under
+any particular circumstance, the balance of the section is intended to
+apply and the section as a whole is intended to apply in other
+circumstances.
+
+It is not the purpose of this section to induce you to infringe any
+patents or other property right claims or to contest validity of any
+such claims; this section has the sole purpose of protecting the
+integrity of the free software distribution system, which is
+implemented by public license practices. Many people have made
+generous contributions to the wide range of software distributed
+through that system in reliance on consistent application of that
+system; it is up to the author/donor to decide if he or she is willing
+to distribute software through any other system and a licensee cannot
+impose that choice.
+
+This section is intended to make thoroughly clear what is believed to
+be a consequence of the rest of this License.
+\f
+ 8. If the distribution and/or use of the Program is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Program under this License
+may add an explicit geographical distribution limitation excluding
+those countries, so that distribution is permitted only in or among
+countries not thus excluded. In such case, this License incorporates
+the limitation as if written in the body of this License.
+
+ 9. The Free Software Foundation may publish revised and/or new versions
+of the General Public License from time to time. Such new versions will
+be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+Each version is given a distinguishing version number. If the Program
+specifies a version number of this License which applies to it and "any
+later version", you have the option of following the terms and conditions
+either of that version or of any later version published by the Free
+Software Foundation. If the Program does not specify a version number of
+this License, you may choose any version ever published by the Free Software
+Foundation.
+
+ 10. If you wish to incorporate parts of the Program into other free
+programs whose distribution conditions are different, write to the author
+to ask for permission. For software which is copyrighted by the Free
+Software Foundation, write to the Free Software Foundation; we sometimes
+make exceptions for this. Our decision will be guided by the two goals
+of preserving the free status of all derivatives of our free software and
+of promoting the sharing and reuse of software generally.
+
+ NO WARRANTY
+
+ 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
+REPAIR OR CORRECTION.
+
+ 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGES.
+
+ END OF TERMS AND CONDITIONS
+\f
+ How to Apply These Terms to Your New Programs
+
+ If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+
+ To do so, attach the following notices to the program. It is safest
+to attach them to the start of each source file to most effectively
+convey the exclusion of warranty; and each file should have at least
+the "copyright" line and a pointer to where the full notice is found.
+
+ <one line to give the program's name and a brief idea of what it does.>
+ Copyright (C) <year> <name of author>
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+
+Also add information on how to contact you by electronic and paper mail.
+
+If the program is interactive, make it output a short notice like this
+when it starts in an interactive mode:
+
+ Gnomovision version 69, Copyright (C) year name of author
+ Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+ This is free software, and you are welcome to redistribute it
+ under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the appropriate
+parts of the General Public License. Of course, the commands you use may
+be called something other than `show w' and `show c'; they could even be
+mouse-clicks or menu items--whatever suits your program.
+
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a "copyright disclaimer" for the program, if
+necessary. Here is a sample; alter the names:
+
+ Yoyodyne, Inc., hereby disclaims all copyright interest in the program
+ `Gnomovision' (which makes passes at compilers) written by James Hacker.
+
+ <signature of Ty Coon>, 1 April 1989
+ Ty Coon, President of Vice
+
+This General Public License does not permit incorporating your program into
+proprietary programs. If your program is a subroutine library, you may
+consider it more useful to permit linking proprietary applications with the
+library. If this is what you want to do, use the GNU Library General
+Public License instead of this License.
--- /dev/null
+People besides Uri who've contributed to Stem code and docs:
+
+Dave Rolsky - various code, bug fixes, docs, etc.
--- /dev/null
+package World1;
+
+# This is class level cell with no constructor or alias registration.
+# It has one simple command message handler
+
+sub hello_cmd {
+
+ return "Hello world!\n";
+}
+
+=head1 Stem Cookbook - World1
+
+=head1 NAME
+
+World1 - A minimal class level B<Stem> cell.
+
+=head1 DESCRIPTION
+
+This is the simplest possible B<Stem> class level cell. It contains a
+single method named C<world_cmd>. Because this method ends in C<_cmd>
+it is capable of being invoked remotely via a command message and have
+its return value sent back as a response message to the sender, which
+in this example is the Stem::Console cell.
+
+=head2 COMMAND METHOD
+
+The following code snippet in the F<World1> class cell is the method
+that will receive a hello command from a remote sender.
+
+ package World1;
+
+ sub hello_cmd {
+
+ return "Hello world!\n";
+ }
+
+B<Stem> makes the creation of Command message handling methods very
+I<easy>. Any return with defined data will automatically be sent back
+to the sender of this command in a response type message. In the
+method above we return the "Hello world!\n" string which will get printed on
+the console.
+
+For more information on how a message is routed to its destination
+cell in B<Stem> please see the F<Stem Messaging Design Notes>.
+
+=head1 THE CONFIGURATION FILE
+
+The following B<Stem> configuration file is used to bring a
+World1 class level cell into existance in the B<Stem> environment.
+
+-
+ class: Stem::Console
+-
+ class: World1
+
+The first entry is C<Stem::Console>, a class level cell allows a user
+to manually send command messages into the B<Stem> system. It is not
+required for this module, but it is used in this example to send
+messages to the World1 class and to print responses from it. The
+second entry loads the C<World1> class. We can now refer to this class
+cell as I<World1> when we want to send it a message.
+
+=head1 USAGE
+
+Execute C<run_stem world> from the command line to run this configuration.
+You will be greeted with the B<StemE<gt>> prompt. It is now
+possible to send a message manually to I<World1>. Type the following
+command at the B<Stem> prompt:
+
+B<World1 hello>
+
+This is standard B<Stem> Console syntax, the cell address followed by
+the command name. This will send a message world_cmd method in the
+C<World1> class cell. That method returns a value, which is converted
+into a response message addressed to Stem::Console (the originator of
+the command message), and its data will be printed on the console terminal.
+
+B<"Hello world!">
+
+=cut
+
+1 ;
--- /dev/null
+package World2;
+
+# This is class level cell with no constructor or alias registration.
+# It has two command message handlers, one to get the name and one to set it.
+
+my $name = 'UNKNOWN' ;
+
+sub hello_cmd {
+
+ return "Hello world from $name\n";
+}
+
+sub name_cmd {
+
+ my ( $self, $msg ) = @_ ;
+
+ my $data = $msg->data() ;
+
+ return unless $data ;
+
+ $name = ${$data} ;
+
+ return ;
+}
+
+
+=head1 Stem Cookbook - World2
+
+=head1 NAME
+
+World2 - A minimal class level B<Stem> cell with read/write data.
+
+=head1 DESCRIPTION
+
+This B<Stem> class level cell is an extension of the World1 class. It
+still has a method named C<world_cmd> that will return the stored
+name. The C<name_cmd> method takes a message and set the $name to its
+data.
+
+=head2 COMMAND METHOD
+
+The following code snippet in the F<World2> class
+cell is the method that will receive a hello command from a
+remote sender.
+
+ package World2;
+
+ sub hello_cmd {
+
+ return "Hello world!\n";
+ }
+
+B<Stem> makes the creation of Command message handling methods very
+I<easy>. Any return with defined data will automatically be sent back
+to the sender of this command in a response type message. In the
+method above we return the "Hello world!\n" string which will get printed on
+the console.
+
+For more information on how a message is routed to its destination
+cell in B<Stem> please see the F<Stem Messaging Design Notes>.
+
+=head1 THE CONFIGURATION FILE
+
+The following B<Stem> configuration file is used to bring a
+World2 class level cell into existance in the B<Stem> environment.
+
+[
+ class => 'Stem::Console',
+],
+[
+ class => 'World2',
+]
+
+The first entry is C<Stem::Console>, class level cell allows a user to
+manually send command messages into the B<Stem> system. It is not
+required for this module, but it is used in this example to send
+messages to the World2 class and to print responses from it. The
+second entry loads the C<World2> class. We can now refer to this class
+cell as I<World2> when we want to send it a message.
+
+=head1 USAGE
+
+Execute C<run_stem world> from the command line to run this configuration.
+You will be greeted with the B<StemE<gt>> prompt. It is now
+possible to send a message manually to I<World2>. Type the following
+command at the B<Stem> prompt:
+
+B<World2 hello>
+
+This is standard B<Stem> Console syntax, the cell address followed by
+the command name. This will send a message world_cmd method in the
+C<World2> class cell. That method returns a value, which is converted
+into a response message addressed to Stem::Console (the originator of
+the command message), and its data will be printed on the console terminal.
+
+B<"Hello world!">
+
+=head1 SEE ALSO
+
+F<Stem Cookbook Part 2>
+
+F<Stem Cookbook Part 3>
+
+=cut
+
+1;
--- /dev/null
+package World3 ;
+
+use strict;
+
+# This is the specification table that describes the attributes for
+# this object. The only attribute is the name of the planet and it
+# defaults to 'X'
+
+my $attr_spec =
+[
+ {
+ 'name' => 'planet',
+ 'default' => 'X',
+ },
+];
+
+# The new method constructs the object which is returned to the
+# configuration system where it will be registered.
+
+sub new {
+
+ my( $class ) = shift ;
+
+# The call to parse_args takes the attribute specification and the
+# configuration arguments and creates a cell object
+
+ my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
+
+ return ( $self );
+}
+
+# This command method is similar to the one in World1 except we
+# we use the object argument and return the name from that object.
+
+sub hello_cmd {
+
+ my( $self ) = @_;
+
+ return "Hello world from $self->{'planet'}!\n";
+}
+
+=head1 Stem Cookbook - World3
+
+=head1 NAME
+
+World2 - A simple object level B<Stem> cell.
+
+=head1 DESCRIPTION
+
+This cell is an extension of the B<World1> cell. In this example,
+instead of a single class cell with a fixed response value, we now can
+create multiple cells (registered objects) each with their own private
+data. The world_cmd method will return the planet's name stored in the
+cell.
+
+=head1 CREATING THE CELL
+
+This cell illustrates the basic way to construct objects in Stem.
+
+=over 4
+
+=item *
+
+A specification table is required to describe the allowed attributes
+of the object. This is a list of hashes with each hash describing one
+attribute. It is usually defined in a file lexical variable commonly
+named $attr_spec which is assigned an anonymous list of attribute
+descriptions. The fields that describe the attributes are defined in
+the F<Stem::Class> module.
+
+=item *
+
+An object constructor is called and is passed a list of key value
+arguments. This class method can be called via a configuration (which
+uses default name of 'new') or from any Stem code. The constructor
+passes its attribute specification table and the passed arguments to
+the Stem::Class::parse_args routine which returns the new object The
+constructor method checks if an error happened by seeing if that
+returned value is an object (ref is true) or else it must be an error
+string. Any error string is returned to the caller of this
+constructor. This is the standard way Stem handles errors, references
+are good values and scalars (error strings) are bad. This propogation
+of error strings up the call stack is consistantly used in all Stem
+modules. After a successful construction of an object, the constructor
+method can do additional work and then it returns the object. The
+caller of the constructor will also check for an object or error
+string. The common case of a configuration file constructing a Stem
+object cell with register a good cell or print the error string and
+die.
+
+=back
+
+=head2 ATTRIBUTE SPECIFICATION
+
+Object cells require an attribute specification that describes
+the information we want to exist independently in each object
+cell when it is created. The following is the attribute specification
+used in C<World2>:
+
+$attr_spec =
+[
+ {
+ 'name' => 'planet',
+ 'default' => 'X',
+
+ },
+
+];
+
+This specification indicates that this cell has an attribute
+named I<planet>. It will default to the value of I<X> if
+this attribute is not specified in the configuration arguments
+for this cell. Some of the attribute specification tags are I<name>,
+I<type>, I<default>, I<required>, I<class>, and I<help>. For more
+information on cell configuration please see
+B<Stem Object and Cell Creation and Configuration Design Notes> and
+B<Stem Cell Design Notes>.
+
+=head2 OBJECT CONSTRUCTOR
+
+This is a minimal B<Stem> constructor with the usual name I<new>. you
+can invoke any other method as a constructor from a configuration by
+using the 'method' field:
+
+sub new {
+
+ my ( $class ) = shift;
+
+ my $self = Stem::Class::parse_args( $attr_spec, @_ );
+ return $self unless ref $self ;
+
+ return ( $self );
+
+}
+
+To create a B<Stem> object cell we call the C<Stem::Class::parse_args>
+routine and pass it the object cell attribute specification and the
+rest of the arguments passed into this constructor. The rest of the
+arguments come from the I<args> field in the configuration for this cell.
+The parse_args function then returns the newly created object to the
+caller, which is usually the configuration system but it could be any
+other code as well. An important observation to make here is the
+B<Stem> error handling technique. Errors, in B<Stem>, are propagated
+up the call stack bu returning an error string rather than a
+reference. This is the typical Stem way of determining whether of not
+an error condition had occurred. Constructors or subroutines which
+normally return objects or references will return a string value as
+an error message. This is always checked by the caller and will usually
+be passed up the call stack until a top level subroutine handles it.
+
+=head1 CREATING THE CONFIGURATION FILE
+
+The following B<Stem> configuration file is used to bring a
+World2 object level cell into existance in the B<Stem> environment.
+
+[
+ class => 'Console',
+],
+
+[
+ class => 'World2',
+ name => 'first_planet',
+ args => [],
+
+],
+
+[
+ class => 'World2',
+ name => 'second_planet',
+ args => [
+ planet => 'venus',
+
+ ],
+
+],
+
+
+As explained in F<World1.pm>, we create a
+C<Stem::Console> cell to allow for the creation of a Stem console
+to manually send command messages and display their responses.
+We also create two object level C<World2> cells.
+The first, we name I<first_planet> and it defaults to having its planet
+attribute set to 'first_planet'. The second, we name I<second_planet> and set its
+planet attribute to 'venus'.
+
+Using the I<args> specifier in the cell configuration indicates
+that we are creating an I<object> cell rather than a class cell.
+It indicates to the B<Stem> cell creation environment that we
+wish to execute the constructor of the specified class to
+create an object of the class rather than using the B<Stem>
+module as a class itself. Using object cells allow us to instantiate
+multiple objects with unique values, addressed and subsequent
+behavior.
+
+=head1 USAGE
+
+Execute C<run_stem world2> from the command line to run this
+configuration. You will be greeted with the B<StemE<gt>> prompt.
+It is now possible to send a message manually into the system.
+
+Type the following at the B<Stem> prompt:
+
+B<reg status>
+
+This will show the status of the local B<Stem> hub. You
+will notice the two entries for the object cells created
+by the configuration file under the object cell section.
+
+Now execute the same command as you did in F<World1>:
+
+B<first_planet hello>
+
+B<Hello, World! (from X)>
+
+B<second_planet hello>
+
+B<Hello, World! (from venus)>
+
+As in F<World1>, the above triggers the C<hello_cmd> method. However,
+now we are triggering the C<hello_cmd> method on separate object cells
+rather than a single class cell.
+
+
+=head1 SEE ALSO
+
+F<Stem Cookbook Part 1>
+
+F<Stem Cookbook Part 3>
+
+F<World2 Module>
+
+=cut
+
+
+1;
--- /dev/null
+package World4 ;
+
+use strict;
+
+my $attr_spec =
+[
+ {
+ 'name' => 'planet',
+ 'default' => 'uranus',
+ },
+];
+
+sub new {
+
+ my( $class ) = shift ;
+ my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
+
+ return ( $self );
+}
+
+# based on who was the receiver of the message
+# we return with the appropriate response
+
+sub hello_cmd {
+
+ my( $self ) = @_;
+
+ return "Hello world from $self->{'planet'}!\n";
+}
+
+sub name_cmd {
+
+ my ( $self, $msg ) = @_ ;
+
+ my $data = $msg->data() ;
+
+ return unless $data ;
+
+ $self->{'planet'} = ${$data} ;
+
+ return ;
+}
+
+
+
+
+=head1 Stem Cookbook - World3
+
+=head1 NAME
+
+World3 - Mixing class and object B<Stem> cells.
+
+=head1 DESCRIPTION
+
+This is an extension of the B<Stem Cookbook Part 1 & Stem Cookbook Part 2> where
+we talked about the creation of B<Stem> class and object cells. In
+this example, we take the idea of a class cell and an object cell
+and combine them into a single B<Stem> module. We then have
+the ability of creating multiple cells (registered objects)
+with their own private data and at the same time have a
+class cell to manage a global resource.
+
+=head1 CREATING THE CELL
+
+The following lists the requirements for creating a B<Stem>
+object level cell:
+
+=over 4
+
+=item *
+
+An attribute specification
+
+=item *
+
+An object constructor
+
+=item *
+
+A class registration
+
+=back
+
+=head2 CHANGES FROM PART 1 AND PART 2
+
+Most of the code from Part 2 and Part 1 remain the same. We keep
+the same attribute specification as well as the same object cell
+constructor (except for a slight modification, see below).
+You remember from Part 1 that we created a class level
+B<Stem> cell from the configuration file,
+
+[
+ class => 'World1',
+ name => 'solar_system',
+
+]
+
+Because we do not have an args field, it means we are creating a
+class cell. In this example, we want a class cell to be created
+as a global resource only if an object cell is created. If the
+class cell is supposed to manage global information for object
+cells there is no need to create one if an object cell does not
+exist. To get this type of behavior, we register the class cell
+from within the B<Stem> module rather than from the configuration
+file,
+
+ Stem::Route::register_class( __PACKAGE__, 'solar_system' );
+
+This line (World3.pm, line 5) effectively registers the class cell
+with the B<Stem> message routing system using the package name
+and a name we wish to register the cell as.
+
+We keep referring to the class cell as a global resource, so in
+this example we create a global resource that the class cell will
+manage,
+
+ my @objects = ();
+
+On line 16 in World3.pm we create an array named objects that will
+be used to hold a reference to each of the World3 cell objects that are
+created from the configuration file (Note that this is not a
+requirement for creating this module and is just used as an example.
+It could have just as easily been a simple scalar, a hash, some
+other kind of object, or even nothing!).
+
+In order to populate this array of the objects that are created from
+the configuration file, we simply add them to the array when they
+are created in the object cell constructor,
+
+ push @objects, $self;
+
+This simply pushes the reference to the newely created World3 object cell
+onto the objects array. The class cell can now be used to represent the
+World3 object cells as a group.
+
+The next modification exists in the hello_cmd subroutine. We need a way
+to distiguish whether or not a message is being sent to an object cell
+as opposed to a class cell. As you might recall, the perl I<ref> function
+is used to determine if a scalar refers to a reference or a normal
+scalar value. If a subroutine is invoked from an object, the first
+argument of the subroutine will be a reference to the object itself,
+otherwise, it will be the string name of the class from which the subroutine
+belongs. The following code demonstrates a new hello_cmd subroutine
+that makes this distinction and performs accordingly,
+
+sub hello_cmd {
+
+ my ($class) = @_;
+
+ return "Hello world from $class->{'planet'}\n" if ref $class;
+
+ my $response_string = '';
+ foreach my $obj (@objects) {
+
+ $response_string .= "Hello world from $obj->{'planet'}\n";
+ }
+
+ return $response_string;
+}
+
+As you can see, we return the familiar "Hello world from $class->{'planet'}"
+string, but this time we check to make sure $class is a reference before
+returning the string. If it is not, we know that the hello_cmd was invoked
+from a message that was intended for the class cell. If this is the case, we
+concatenate a "Hello, World ..." string for each of the Hello3 object cells
+that were stored in the objects array and send that string as a response
+message to the sender.
+
+=head1 SEE ALSO
+
+F<Stem Cookbook Part 1>
+
+F<Stem Cookbook Part 2>
+
+F<Hello3 Module>
+
+=cut
+
+1;
--- /dev/null
+package World5 ;
+
+use strict;
+
+use base 'Stem::Cell' ;
+
+my $attr_spec =
+[
+ {
+ 'name' => 'planet',
+ 'default' => 'world',
+ },
+ {
+ 'name' => 'cell_attr',
+ 'class' => 'Stem::Cell',
+ },
+];
+
+sub new {
+
+ my( $class ) = shift ;
+ my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
+ return $self unless ref $self ;
+
+# Track the object in the class level hash %planets
+
+ return ( $self );
+}
+
+sub triggered_cell {
+
+ my( $self ) = @_ ;
+
+ $self->{'planet'} = $self->cell_get_args( 'planet' ) || 'pluto' ;
+
+ return;
+}
+
+# based on who was the receiver of the message
+# we return with the appropriate response
+
+sub hello_cmd {
+
+ my( $self ) = @_;
+
+ return "Hello world from $self->{'planet'}\n" ;
+}
+
+=head1 Stem Cookbook - World3
+
+=head1 NAME
+
+World5
+
+=head1 DESCRIPTION
+
+=cut
+
+1;
--- /dev/null
+chapter: Hello world!
+name: A Stem Cell Cookbook
+
+title: A few questions about a simple sub
+
+*: What can you do with this sub?
+*: Can it be networked?
+*: Can it receive messages?
+*: Can it send messages?
+
+code:
+package World1;
+
+sub world_cmd {
+
+ return "Hello world!\n";
+}
+
+PAGE_END
+
+title: A few questions about a simple sub: Answers
+
+*: It can be networked under Stem
+*: It can receive Stem messages
+*: It can send Stem messages
+*: No coding changes need to be made
+
+code:
+package World1;
+
+sub world_cmd {
+
+ return "Hello world!\n";
+}
+
+PAGE_END
+
+title: Loading World1 into Stem
+
+*: Stem configuration files load modules and register Cells
+*: This configuration loads the console module and the World1 module
+*: This is YAML (yaml.org) format and other formats are supported
+*: Start it with: run_stem worlds.stem
+
+code:
+--- #YAML:1.0
+-
+ class: Stem::Console
+-
+ class: World1
+
+PAGE_END
+
+title: Stem overview
+
+*: Stem is a message passing, event driven system
+*: Stem Cells are Perl objects that are registered
+*: Cells can be Perl classes or instantiated objects
+*: Cells can send and receive messages.
+*: Cell classes are loaded and Cells are created via Stem configuration files
+*: Stem Hubs (processes) can support many active Cells
+*: Stem Hubs can be connected in networks on one or more systems
+*: Any Cell can send a message to any other reachable Cell
+
+PAGE_END
+
+title: Stem message delivery
+
+*: Messages are objects with address, content and related fields
+*: The 'to' address of a message is used to identify the destination
+ Cell (Perl object)
+*: The destination Cell is invoked by a method and the message is
+ its only argument
+*: The method to be called is determined by the message type and command
+*: A 'foo' command message is delivered to method 'foo_cmd'
+*: A 'bar' type message is delivered to method 'bar_in'
+*: Command methods can optionaly return data which is sent back in in
+ reply to the sender.
+
+PAGE_END
+
+title: Stem addresses
+
+*: Stem Addresses are name triplets: Hub, Cell, Target
+*: The Hub is the name of Stem process
+*: The Cell is the registered name of the Stem object or class
+*: The target is the unique address of a cloned Cell
+*: The Cell part of an address is required and the Hub and Target are optional
+*: Addresses are written in string form in Stem configuration or from
+ the console.
+
+code:
+ cell
+ hub:cell
+ :cell:target
+ hub:cell:target
+
+PAGE_END
+
+title: Adding class level data
+
+*: We add class level data and a method to change it
+*: The file lexical variable $name stores the planet's name
+*: The method 'name_cmd' can set that name from the data in a message
+*: A 'name' command message can be sent from the console or anywhere
+*: The configuration file doesn't change other except for the name of the
+ class it loads
+
+code:
+<blue>
+package World2;
+use strict ;
+my $name = 'UNKNOWN' ;
+</font>
+sub world_cmd {
+ <blue>return "Hello world from $name\n";</font>
+}
+<blue>
+sub name_cmd {
+
+ my( $class, $msg ) = @_ ;
+
+ my $data = $msg->data() ;
+
+ return unless $data ;
+
+ $name = ${$data} ;
+
+ return ;
+}
+</font>
+PAGE_END
+
+title: A basic object level Cell
+
+*: This module has an attribute specification so we can construct an object
+*: If no planet name is passed to the constructor, it will be named 'X'
+*: It also has a constructor method new() that is called from the configuration
+*: The hello_cmd method now returns the object data in the planet attribute
+
+code:
+package World3;
+
+use strict ;
+
+<blue>my $attr_spec = [
+ {
+ 'name' => 'planet',
+ 'default' => 'X',
+ },
+] ;
+
+sub new {
+ my ( $class ) = shift ;
+ my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
+ return ( $self );
+}</font>
+
+sub hello_cmd {
+
+ <blue>my( $self ) = @_ ;
+
+ return "Hello world from $self->{'planet'}\n" ;</font>
+}
+
+PAGE_END
+
+title: Configuration for object level cells
+
+*: We add a 'name' field which is the cell part of the address for this
+ object Cell
+*: We add an 'args' field whose values are passed to the new() method
+*: The object is constructed and registered with the selected 'name'
+*: The initial value of the planet name can be set in the arguments
+*: We created two object cells here using the same class but the first
+ uses the default planet name of 'X' and the second is named 'venus'
+
+code:
+--- #YAML:1.0
+-
+ class: Stem::Console
+-
+<blue> class: World3
+ name: planet1
+ args: []
+-
+ class: World3
+<blue> name: planet2
+ args:
+ planet: venus</font>
+
+PAGE_END
+
+title: Changing object data
+
+*: All that is needed is a name_cmd method very similar to the one in World2
+*: It just changes the value in the cell itself
+*: The configuration file needs to only change the class and cell names
+
+code:
+package World4 ;
+
+use strict ;
+
+my $attr_spec = [
+ {
+ 'name' => 'planet',
+ 'default' => 'X',
+ },
+] ;
+
+sub new {
+ my ( $class ) = shift ;
+ my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
+ return ( $self );
+}
+
+sub hello_cmd {
+
+ my( $self ) = @_ ;
+
+ return "Hello world from $self->{'planet'}\n" ;
+}
+<blue>
+sub name_cmd {
+
+ my ( $self, $msg ) = @_ ;
+
+ my $data = $msg->data() ;
+
+ return unless $data ;
+
+ $self->{'planet'} = ${$data} ;
+
+ return ;
+}
+
+</font>
+
+
+PAGE_END
+
+title: Cloning object cells
+
+*: Cloned Cells are similar to sessions or state objects but are much
+ simpler to create and manage
+*: Object Cells that use the cloning services of Stem::Cell are called
+ parent Cells
+*: All cloned Cells are owned by the Parent cell
+*: When a parent Cell is triggered (via a message or internal call), it
+ copies and registers the clone with a unique target address
+*: The Stem::Cell module is inherited and it handles the 'cell_trigger'
+ command message
+*: The specification must include a Stem::Cell class attribute
+
+ Note that it has its own default
+*: A callback to the 'triggered_cell' method is made in a newly cloned cell
+
+code:
+package World5 ;
+
+<blue>use base 'Stem::Cell' ;</font>
+
+use strict ;
+
+my $attr_spec = [
+ {
+ 'name' => 'planet',
+ 'default' => 'X',
+ },
+ <blue>{
+ 'name' => 'cell_attr',
+ 'class' => 'Stem::Cell',
+ },</font>
+] ;
+
+sub new {
+ my ( $class ) = shift ;
+ my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
+ return ( $self );
+}
+
+sub hello_cmd {
+
+ my( $self ) = @_ ;
+
+ return "Hello world from $self->{'planet'}\n" ;
+}
+<blue>
+sub triggered_cell {
+
+ my( $self ) = @_ ;
+
+ $self->{'planet'} = $self->cell_get_args( 'planet' ) || 'pluto' ;
+
+ return;
+}
+</font>
+
+sub name_cmd {
+
+ my ( $self, $msg ) = @_ ;
+
+ my $data = $msg->data() ;
+
+ return unless $data ;
+
+ $self->{'planet'} = ${$data} ;
+
+ return ;
+}
+
+PAGE_END
+
+title: Cloning cell configuration
+
+*: This is the similar to the World4 configuration but we added the
+ 'cell_attr' attribute and set its 'cloneable' flag to true
+
+code:
+
+-
+ class: World5
+ name: planet5
+ args:
+ planet: jupiter
+ <blue>cell_attr:
+ cloneable: 1
+</font>
+
+PAGE_END
--- /dev/null
+--- #YAML:1.0
+# This is YAML format Stem configuration file. It load a colsole cell
+# and all the cookbook classes and registers a number of object cells
+#
+# Load and initialize the console class
+-
+ class: Stem::Console
+# Load the World1 class. We pass no arguments as this is a class level cell.
+-
+ class: World1
+# Load the World2 class. We pass no arguments as this is a class level cell.
+-
+ class: World2
+# Load the World3 class, construct an object with an empty argument list
+# and register is as a Cell with the name 'planet1'.
+# This Cell will use the default value for its name attribute
+-
+ class: World3
+ name: planet1
+ args: []
+# Construct another World3 object with an argument list and register
+# that as the Cell with the name 'planet2.
+# This Cell will use the value 'venus' for its name attribute
+-
+ class: World3
+ name: planet2
+ args:
+ planet: venus
+# Load the World4 class, construct an object with an argument list and
+# register that as the Cell with the name 'planet3.
+# This Cell will use the value 'earth' for its name attribute
+-
+ class: World4
+ name: planet3
+ args:
+ name: earth
+# Construct another World4 object with an argument list and
+# register that as the Cell with the name 'planet4.
+# This Cell will use the value 'mars' for its name attribute
+-
+ class: World4
+ name: planet4
+ args:
+ planet: mars
+# Load the World5 class, construct an object with an argument list and
+# register that as the Cell with the name 'system.
+# This Cell will use the value 'jupiter' for its name attribute and be
+# cloneable. The value in name will be the default name for all Cells
+# cloned from this parent
+-
+ class: World5
+ name: planet5
+ args:
+ planet: jupiter
+ cell_attr:
+ cloneable: 1
--- /dev/null
+
+ Stem Demonstration Scripts
+
+Stem comes with several demonstration scripts and example configuration
+files which are used by them. You can optionally install the executable
+demonstrations and their configuration files. Note that the actual
+demonstration scripts don't do anything special to Stem, they just
+create windows and execute run_stem inside them with selected
+configuration files. They also create telnet connections inside other
+windows which you can use to interact with Stem. You can manually create
+the windows and do the same commands, these scripts are just
+conveniences. In fact, a good way to learn more about Stem is to copy
+and modify the configuration files used in the demonstrations and run
+them yourself.
+
+When you run any of the demo scripts, the commands used to fork off an
+xterm are printed. You can manually run those commands in your own
+terminal windows if you want to experiment with or explore the Stem
+configurations. If you kill the script (e.g. with ^C), all the created
+xterm windows will be killed off leaving you with a cleaned up desktop.
+
+There are 4 demonstration scripts that come with Stem. They are briefly
+described here and in more detail in other files. They all have some
+common features which are also described in detail below.
+
+ chat_demo and chat2_demo demonstrate a simple 4 user chat
+ server. chat_demo runs with a single Stem Hub and chat2_demo
+ uses 2 Hubs. Both bring up an xterm for each Stem Hub and 4 more
+ for the telnet sessions. Read DEMO_CHAT for the full details on
+ how to use this demo.
+
+ inetd_demo emulates the inetd Unix super-daemon. It runs a
+ single Stem Hub in an xterm and 4 telnet sessions each in their
+ own xterm. The server process it runs is proc_serv in the bin
+ directory. You can run it directly from the command to see how
+ it behaves (it is a simple command/response program). Read
+ DEMO_INETD for the full details on how to use this demo.
+
+ tail_demo monitors a typical log file and copies any new data it
+ finds there to a Stem Logical Log which writes it to a file and
+ optionally to other destinations. The status of the source file
+ is also sent to a Logical Log. Read DEMO_TAIL for the full
+ details on how to use this demo.
+
+Using the console Cell Stem::TtyMsg
+
+All of the demo configurations include the Stem::TtyMsg module which
+allows you to enter command messages from the keyboard to a running Stem
+Hub (process). This module is not required to run Stem but it is in the
+demo configurations so you can interact with Stem and learn more about
+it.
+
+It reads lines from STDIN (using the Stem::AsyncIO module so the rest of
+the Stem Hub continues to run), parses them and sends out a command
+messages based on the lines. It also can set key/values in the local
+Hub's environment (%Stem::Vars::Env) which is used to control many Stem
+operations.
+
+Command messages can generate response messages which will be sent back
+to the TtyMsg Cell. These responses will be printed to STDOUT (again,
+using the Stem::AsyncIO module). Any Cell can just send a data message
+to the TtyMsg Cell (which is also registered with the class Cell name
+tty) and its data will get printed.
+
+The rules for parsing lines input to TtyMsg are very simple. There are
+three kinds of command lines:
+
+ Direct commands
+
+ The only direct command is 'help' which has to be the
+ only token on the line. It causes the help text to be
+ printed.
+
+ Setting a Stem environment variable
+
+ Key/values in the local Hub's environment can be set
+ with lines of the form:
+
+ name=value
+
+ Token has to be only word characters ([a-zA-Z0-9_]) and
+ the string after the = is the value (stripped of
+ surrounding white space). The Hub environment variable
+ with the name token is set to the parsed value. The
+ token and value are printed.
+
+ You can also set any environment variable in any remote
+ Hub with the command message:
+
+ hub:var set_env name=value
+
+ Note that 'hub' must be the real name of that Stem Hub,
+ and var is already the registered class name of the
+ Stem::Vars class Cell.
+
+ See below for more on entering command messages and the
+ env_notes document in /Design.
+
+ Sending a Command Message
+
+ A command message line starts with a Cell address and
+ then must have a command token. The rest of the line is
+ optional data for the command message. A minimal Cell
+ address is just a Cell name. It can have an optional Hub
+ name prefix. Also a target name can be suffixed after a
+ trailing :. So the only legal Cell addresses look like
+ this:
+
+ cell
+ hub:cell
+ :cell:target
+ hub:cell:target
+
+ If the Hub is missing the message is destined for the
+ local Hub and if the Cell doesn't exist here, it is
+ routed to the DEFAULT Hub. Read the Cell and Message
+ technical note for more on this.
+
+ The next token on a message command line is the command
+ name and it is required. It will be the value of the
+ 'cmd' field in the message. The rest of the line is used
+ as the data field of the message.
+
+ Some uses of command line messages are getting the
+ status of various Class Cells since almost all of them
+ have a status command. By listing all the registered
+ Cells you can see which ones you can send messages to.
+
+ This will print all of the Cells in this hub. The
+ listing shows all object Cell and Class Cells with their
+ aliases. Command line messages should use the aliases
+ for the Cell name as the class names have colons in
+ them.
+
+ This will print all of the Cells in the local hub.
+
+ reg status
+
+ This will print all of the Cells in the hub named remote.
+
+ remote:reg status
+
+ This will print all of the Portals in this hub. You can
+ use their hub names to send command messages to those
+ hubs.
+
+ port status
+
+ If you are running either chat demo you can change the
+ Switch maps which control which user get sent chat
+ messages. Here are some examples. The Switch Cell is
+ named sw, and the two Hubs in chat2_demo are named
+ chat_client and chat_server. Note that the 'sw' Cell is
+ only in the server Hub in chat2_demo, but since no 'sw'
+ Cell exists in the client Hub, any message sent to 'sw'
+ will still go to the server hub. So all of these map
+ commands can be issued from either Hub input and they
+ will work. The 'map' or 'status' token is the command
+ and the tokens after 'map' are data to the map
+ command. The first data token is the input map you are
+ setting and the rest of the tokens are the output maps
+ to send chat messages to.
+
+ Print the current maps.
+
+ sw status
+
+ Change the a map to just b.
+
+ sw map a b
+
+ Change the d map to all users.
+
+ sw map d a b c d
--- /dev/null
+
+
+ Demonstration of Chat Server Emulation
+
+These two demonstration scripts emulate a very simple chat server with 4
+connected users. They showcase the Stem modules Stem::Switch (which
+multiplexes Stem Messages) and Stem::SockMsg (a socket to message
+gateway). chat_demo and chat2_demo behave the same but the former runs
+as a single Stem Hub (process) and the latter as two Hubs (which can be
+on separate systems - see below to experiment with that). Just like
+with real chat, a user can type into their terminal and their text will
+appear on the windows of other users. The Stem::Switch Cell (configured
+as 'sw') acts as the chat server and it controls which users will see
+the text from other users. You can change that user to user map by
+issuing command messages to the 'sw' Cell (see DEMO for more on entering
+command messages from the terminal). The two demo scripts are described
+in detail below with sections on running, using, configuring and
+experimenting with them.
+
+Running chat_demo
+
+The single Hub chat demonstration is called chat_demo and it uses the
+chat.stem configuration file (found in conf/ and also where you
+installed the demo Stem configurations). It is run with the simple
+command:
+
+chat_demo
+
+To exit, just enter 'quit' in the chat_demo script window itself. It will
+kill all the other windows and then exit. This will also happen if you
+interrupt the demo script with ^C.
+
+If the -s option is used, then all the windows will use ssfe (split
+screen front end which you can install from the Stem distribution) which
+provides a command line edit and history window section and an output
+section. A single Hub window will be created and then 4 smaller telnet
+windows which will be connected to listen sockets in the Stem Hub. These
+telnet windows are the chat users and they can type data and other users
+will see the output. The telnet windows are named A, B, C and D.
+
+Using chat_demo
+
+Now type a line of text into A's window and hit return. Notice how all 4
+windows see that text. Now do the same for D. Only C will see its
+text. This is controlled by the map in the Stem::Switch Cell named
+'sw'. You can print out that map by sending a status command message to
+that Cell. In the Hub window (named Stem) type this command:
+
+sw status
+
+You will see this printout:
+
+ Status of switch: sw
+
+ In Map:
+
+ a -> a b c d
+ b -> a
+ c -> b d
+ d -> c
+
+ Out Map:
+
+ a -> A
+ b -> B
+ c -> C
+ d -> D
+
+This shows that a data message that came in with the Message target 'a'
+will have its data copied to all 4 users and that 'd' will only send
+text to 'c'. The Message target name is used as a key to index into the
+In Map which gets a list of keys to the Out Map. The Out Map is then
+indexed and a list of Cell addresses is found. Those addresses are sent
+a copy of the data message. Now you should be able to predict what will
+happend to text entered on B or C. Note that the internal keys are not
+related to any other namespaces and are private to this Cell. The Switch
+Cell's maps can be changed by command messages sent to this Cell.
+
+Also run this command in the Hub window:
+
+reg status
+
+This sends a status message to the Class Cell Stem::Route which has the
+alias 'reg'. It returns a listing of all registered Cells with their
+Cloned Cell names or Class Cell Aliases. You can run this command in any
+Hub window to find the list of registered Cells. Most of the Class
+Cells support and some Object Cells support status commands which can be
+sent from the console.
+
+
+Configuring chat_demo
+
+Look at the file conf/chat.stem. That is the configuration file used by
+chat_demo. It is very simple and easy to understand. It is a Perl list
+of lists structure with key/value pairs. Read the config_notes for more
+on this.
+
+The first Cell configured is Stem::TtyMsg which supports typing in and
+sending command messages. This Cell is used in all the demo
+configurations. You can use it for any Stem application where you might
+want to enter command messages by hand.
+
+ [
+ class => 'Stem::TtyMsg',
+ args => [],
+ ],
+
+Then come four Stem::SockMsg Cells named A, B, C and D. Each has a
+single server socket listening on its own port. Also they are configured
+(via the 'data_addr' attribute) to send their data to the same 'sw' Cell
+but with the target addresse a, b, c, or d. These Cells allow
+the user telnets to connect to this Hub.
+
+[
+ class => 'Stem::SockMsg',
+ name => 'A',
+ args => [
+ port => 6666,
+ server => 1,
+ cell_attr => [
+ 'data_addr' => ':sw:a'
+ ],
+ ],
+],
+
+Finally we have the Stem::Switch Cell named 'sw' which controls the
+mapping of users to users. It is just like the output from the first
+status command we did above. It sets the input maps to the list of
+internal target names and the output map is set to Cell addresses that
+redirect the incoming messages.
+
+[
+ class => 'Stem::Switch',
+ name => 'sw',
+ args => [
+
+ in_map => [
+
+ a => [ qw( a b c d ) ],
+ b => 'a',
+ c => [ qw( b d ) ],
+ d => 'c',
+ ],
+
+ out_map => [
+
+ a => 'A',
+ b => 'B',
+ c => 'C',
+ d => 'D',
+ ],
+ ],
+],
+
+Experimenting with chat_demo
+
+Now try to send a map command message to the 'sw' Cell. Enter this in
+the Hub window:
+
+sw map b b c d
+
+and then type something into B. You should see it print on B, C, and D's
+windows. You can change any of the maps. The 'map' token is the command
+(as was 'status') and b is the input map name you are changing. The rest
+of the tokens are the internal keys to output map. You can always print
+out the map with the status command (as shown above) and verify your
+changes.
+
+Running chat2_demo
+
+You run chat2_demo also by just typing the script name and its basic
+behavior is just like chat_demo. The main difference is that it runs two
+Stem Hubs and the four users are split with two connecting to each
+Hub. So there are two configuration files named chat_server.stem and
+chat_client.stem and they are in conf/ directory. When you run
+chat2_demo, two Hub windows will be created with the names Chat1 and
+Chat2. The two Stem Hubs are called 'server' and 'client' and those
+names only reflect how they initially connect via sockets. Once they are
+properly connected, they communicate in a peer to peer fashion.
+
+Using chat2_demo
+
+You can interact with chat2_demo just as you did with chat_demo. The
+same user to user mapping is in effect and you can enter user text the
+same way and also change the map. In fact you can enter and send all the
+same command messages you did before in either Hub window and you will
+see similar output. The major difference is that 2 of the output map
+Cell addresses have Hub values.
+
+First enter the 'reg status' command in each Hub window. Notice how the
+'server' Hub (window named Chat1) has the C and D Stem::SockMsg Cells
+and the Stem::Switch Cell named 'sw'. The 'client' Hub (window named
+Chat2) has only the A and B Stem::SockMsg Cells. This means that the
+users connected to the 'client' Hub have to
+
+Now enter this command in each of the two Hub windows:
+
+port status
+
+That sends a 'status' command to the Class Cell Stem::Portal of the Hub.
+
+The 'server' Hub will print:
+
+Portal Status for Hub 'server'
+ client => Stem::Portal=HASH(0xd2978)
+
+This shows that this Hub can send messages to another Hub named 'client'
+And the 'client' Hub will print:
+
+Portal Status for Hub 'client'
+ DEFAULT => Stem::Portal=HASH(0xd0930)
+ server => Stem::Portal=HASH(0xd0930)
+
+This shows that this Hub can send messages to another Hub named 'server'
+and to one named 'DEFAULT' which is the same portal as 'server'. When a
+message doesn't have a Hub name in its 'to' address and it can't be
+delivered locally, it is sent to a Portal named DEFAULT if it can be
+found. This is similar to the default route in IP networks.
+
+How chat2_demo is Configured
+
+Look at the files conf/chat_server.stem and conf/chat_client.stem. They
+are the configuration files used by chat2_demo. They are basically
+copies of chat.stem with support for two hubs and the Stem::SockMsg
+Cells split between them. The new Cell addition to both is Stem::Portal
+which supports send messages between Hubs. The 'server' Hub has this:
+
+[
+ class => 'Stem::Portal',
+ args => ['server' => 1 ],
+],
+
+That makes this Hub a server which listen for connections from other
+Stem Hubs. The default port number is 10,000 (though this will change
+soon). There is no 'host' attribute in that Stem::Portal Cell so it uses
+the localhost interface by default. The 'client' Hub doesn't have a
+server attribute so it is a client and it connects by default to
+localhost and the port 10,000.
+
+[
+ class => 'Stem::Portal',
+ args => [],
+],
+
+Then come four Stem::SockMsg Cells with A and B in stem_client.stem and
+C and D in stem_server.stem. And finally the Stem::Switch Cell named
+'sw' which is only in stem_server.stem. Note that the output map for 'a'
+and 'b' have the Hub name 'client' in their Cell addresses. This is
+because the A and B users are connecting to the 'client' Hub and this
+Stem::Switch Cell needs to know that so it can send them data. In a more
+realistic chat system, these switch maps would be controlled by end user
+commands and not by entering command messages.
--- /dev/null
+
+ Demonstration of Inetd Server Emulation
+
+This demonstration script emulates the standard inetd super-daemon found
+on all Unix systems. It showcases the Stem modules Stem::Proc (which
+handle processes) and Stem::SockMsg (a socket to message gateway). This
+demonstration runa a single Hub which listens for socket connections on
+two ports. When a connection comes in, a new process is spawned which
+interacts with the remote client that made the connection. This is
+effectively what inetd does but inetd_demo has several major
+advantages. StemInetd can insert filters and/or taps in the data stream,
+all its connections and status changes can be logged and filtered and it
+can be distributed securely across a network. The demo script is
+described in detail below with sections on running, using, configuring
+and experimenting with it.
+
+Running inetd_demo
+
+The single Hub inetd demonstration is called inetd_demo and it uses the
+inetd.stem configuration file (found in conf/). It is run with the simple
+command:
+
+inetd_demo
+
+To exit, just enter 'q' in the inetd_demo script window itself. It will
+kill all the other windows and then exit. This will also happen if you
+interrupt the demo script with ^C.
+
+If the -s option is used, then all the windows will use ssfe (split
+screen front end) which provides a command line edit and history window
+section and an output section. A single Hub window named Stem will be
+created and then 4 smaller telnet windows which will be connected to
+listen sockets in the Stem Hub. These telnet windows are the inetd users
+and they can type data and interact with a simple command line server
+program named proc_serv. The telnet windows are named A, B, C and D and
+if you use ssfe, each will display the telnet command it ran.
+
+Using inetd_demo
+
+Now enter the help command into window A and hit return. These are the
+commands you give the proc_serv application. Each of the user windows is
+connected to a different running proc_serv process. You can verify this
+by running the pid command in each window. Then have fun with the yow
+and insult commands. Later in the experimenting section, you can change
+the program to run and its options. The major difference among the user
+windows is that two of them A and C are connected to the 6666 port in
+the Hub and run the proc_serv in normal mode. The B and D windows are
+connected to the 6667 port in the Hub and run the proc_serv with -n so
+numbers the successful output lines.
+
+You can print out the list of all the registered Cells by sending a
+status command message to the Stem:Route Class Cell which is aliased to
+'reg'. In the Hub window (named Stem) type this command:
+
+reg status
+
+You will see this printout:
+
+Route Status for Hub ''
+
+ Object Cells with Target names of their Cloned Cells
+
+ A => Stem::SockMsg=HASH(0x2dd5a0)
+ :aaaaaa => Stem::SockMsg=HASH(0x2fda20)
+ :aaaaab => Stem::SockMsg=HASH(0x350ab0)
+ B => Stem::SockMsg=HASH(0x2ed474)
+ :aaaaaa => Stem::SockMsg=HASH(0x2c10ac)
+ :aaaaab => Stem::SockMsg=HASH(0x355040)
+ proc_serv => Stem::Proc=HASH(0x2fdbc4)
+ :aaaaac => Stem::Proc=HASH(0x3515c4)
+ :aaaaad => Stem::Proc=HASH(0x35554c)
+ :aaaaaa => Stem::Proc=HASH(0x2f881c)
+ :aaaaab => Stem::Proc=HASH(0x352660)
+
+ Class Cells with their Aliases
+
+ Stem::Conf => conf
+ Stem::Demo::Cmd => cmd
+ Stem::Hub => hub
+ Stem::Log =>
+ Stem::Log::Entry => entry
+ Stem::Portal => port
+ Stem::Route => foo reg
+ Stem::TtyMsg => tty
+ Stem::Vars => var
+
+This shows the Parent Object Cells A, B and proc_serv each with their
+own set of Cloned Cells. Below that are the loaded Class Cells.
+The two Stem::SockMsg Cells have 2 telnet users connected to them and
+the proc_serv Cell has cloned four Objects, each of which manages a
+single process. Note that parent Cells don't do the work, they manage
+the Cloned Cells which do it.
+
+
+How inetd_demo is Configured
+
+Look at the file conf/inetd.stem. That is the configuration file used by
+inetd_demo. It is very simple and easy to understand. It is a Perl list
+of lists structure with pairs of keys and values. Read the config_notes
+for more on this.
+
+The first Cell configured is Stem::TtyMsg which supports typing in and
+sending command messages. This is done in all the demo configurations.
+
+ [
+ class => 'Stem::TtyMsg',
+ args => [],
+ ],
+
+Then come two Stem::SockMsg Cells named A and B. Each has a server
+socket listening on its own port. Also they each will create a piped
+connection to the cell named 'proc_serv'. The Cell B has one extra
+attribute set, it adds the -n option when a process is spawned for it.
+
+[
+ class => 'Stem::SockMsg',
+ name => 'A',
+ args => [
+ port => 6666,
+ server => 1,
+ piped_to => 'proc_serv',
+ ],
+],
+[
+ class => 'Stem::SockMsg',
+ name => 'B',
+ args => [
+ port => 6667,
+ server => 1,
+ piped_to => 'proc_serv',
+ piped_args => [ '-n' ],
+ ],
+],
+
+
+
+Finally we have the Stem::Proc Cell named 'proc_serv' which can clone
+itself and spawn off processes.
+
+[
+ class => 'Stem::Proc',
+ name => 'proc_serv',
+ args => [
+ path => 'proc_serv',
+ use_stderr => 1,
+ piped_to => 1,
+ no_init_spawn => 1,
+ ],
+],
+
+The 'path' attribute is the absolute path or program name to
+be run. Note that this configuration assumes it will find 'proc_serv in
+$PATH. The three boolean attributed tell the Cell that it should handle
+output from stderr of the process, it is expecting a pipe connection
+request and it should only spawn processes when it has been cloned.
+
+
+Experimenting with inetd_demo
+
+These experiments are similar to the Hub and Portal ones in
+DEMO_CHAT. They show you how to change the processes StemInetd runs, and
+to distribute it over multiple systems over secure connections. Choose a
+second system and make sure Stem is properly installed on it (NFS
+mounting the tarball dir will help).
+
+To support a remote Hub connecting the Hub which owns the Stem::Proc
+Cell, you have to add a Stem::Portal Cell to each of them.
+
+Make two copies of the configuration file conf/inetd.stem and call them
+inetd_server.stem and inetd_client.stem
+
+Edit inetd_server.stem and rename the Stem::Hub configuration to
+inetd_server. Also insert this Stem::Portal Cell configuration into it
+replacing 'foo_host' with the server hostname:
+
+[
+ class => 'Stem::Portal',
+ args => [
+ 'server' => 1,
+ 'host' => 'foo_host'
+ ],
+],
+
+
+Edit inetd_client.stem and rename the Stem::Hub configuration to
+inetd_client. Delete the Stem::Proc Cell configuration. Also insert
+this Stem::Portal Cell configuration into it replacing 'foo_host' with
+the server hostname:
+
+[
+ class => 'Stem::Portal',
+ args => [
+ 'host' => 'foo_host'
+ ],
+],
+
+
+You can create and modify as many of the Stem::SockMsg Cells as you want
+on each Hub. Then in a window on the server box, do:
+
+run_stem inetd_server
+
+and on a window in the other box (called bar_host) where Stem is setup do:
+
+run_stem inetd_client
+
+You can create telnet sessions from the 'server' system that connect
+to the ports of the Stem::SockMsg Cells.
+
+telnet localhost 6666
+telnet localhost 6667
+
+And on the 'inetd_client' system, connect telnets to the ports of its
+Stem::SockMsg Cells.
+
+telnet localhost 6666
+telnet localhost 6667
+
+You can now interact with this Stem application just as you did when it
+was running on one system as it did with inetd_demo.
+
+Instead of editing the configuration files, you could also set the
+Stem::Portal host attribute by setting a command line argument or
+environment variable. This command will make the 'server' Hub accept
+connections from the 'foo' host interface:
+
+run_stem host=foo chat_server
+
+You can do the same for the 'client' Hub and have it connect to host
+'foo'. By setting the STEM_HOST environment variable to the host name
+you can get the same effect.
--- /dev/null
+
+ Demonstration of Log Tail
+
+This demonstration script illustrates Stem's ability to monitor log
+files. It showcases the Stem modules Stem::Log (which logs messages)
+and Stem::LogTail (which checks files for changes/updates). This
+demonstration runs two hubs named archive and monitor. The monitor
+hub watches a particular log file for changes. When a change occurs,
+messages are sent to the archive hub to be logged. The archive
+hub records the contents of the monitored log file (sent by the
+monitor hub) and also records status messages sent by the monitor
+hub. Log messages that are recorded by the archive hub can be
+stored as either raw data or with custom formats. This demonstrates
+a single log file being monitored, in a real world case there could be
+several log files being monitored. It is easy to see in this example that
+Stem can handle this with a small number of additions to its
+configuration files. This can be distributed securely across a network.
+This demo script is described in detail below with sections on
+running, using, configuring, and experimenting with it.
+
+Running tail_demo
+
+The log tail demonstration is called tail_demo and it uses monitor.stem
+and archive.stem configuration files (found in conf/). It is run with
+the simple command:
+
+tail_demo
+
+To exit, just enter 'q' in the tail_demo script window itself. It will
+kill all the other windows and then exit. This will also happen if you
+interrupt the demo script with ^C.
+
+If the -s option is used, then all the windows will use ssfe (split
+screen front end) which provides a command line edit and history window
+section and an output section. Two hub windows named Archive and
+Monitor will be created and a single shell window will be created with its
+current directory set to tail/. Stem will create two log files
+in the tail/ directory, bar.log and bar_status.log. bar.log is used
+by the archive hub to record what ever is sent to that log file and
+bar_status.log is used as a log file for status messages.
+The hub windows can be used to interact with that hubs Stem environment
+and the command line window can be used to put contents into a foo.log
+file. The two hub windows use the standard module Stem::TtyMsg which
+allows you to interact with them. In this demo they will be used to
+modify the Stem environment which will affect the behavior of the
+logical logs.
+
+Using tail_demo
+
+Initially, bar.log and bar_status.log will be empty files but in 10
+seconds (the tailing interval set in the monitor.stem configuration)
+the status log will have a message about foo.log not being found. Run
+ls -l several times in the shell (center) window to see when the status
+has been logged and then read that file will
+
+$ cat bar_status.log
+
+Now type the following at the command line (in the shell window):
+
+$ echo 'foobar' > foo.log
+
+After 10 seconds (configured in the Stem configuration file)
+you can look in bar.log and you will notice that there is a single line
+that reads, "foobar", and in bar_status.log you will notice that there
+is a status message saying that it is the first time that foo.log was
+opened. And, of course, we have the line "foobar" in the monitored log
+file, foo.log.
+
+Configuring tail_demo
+
+Look at the file conf/monitor.stem. That is one of the configuration files
+used by tail_demo. It is very simple and easy to understand. It is a Perl list
+of lists structure with key/value pairs. Read the config_notes for more
+on this.
+
+The first Cell configured is Stem::Hub which names this hub as
+'monitor'.
+
+ [
+ class => 'Stem::Hub',
+ name => 'monitor',
+ args => [],
+ ],
+
+Next comes the configuration for the Stem::Portal cell,
+
+ [
+ class => 'Stem::Portal',
+ args => [
+ ],
+ ],
+
+It is important to note here that there are no args passed into the
+portal. This means that the portal is a client portal, its default
+host is set to localhost, and its default port is set to 10,000. For
+more information on portals, read the portal design notes.
+
+The next Cell configured is Stem::TtyMsg which supports typing in and
+sending command messages. This is used in all the demo configurations.
+
+ [
+ class => 'Stem::TtyMsg',
+ args => [],
+ ],
+
+The next cell is the application specific part in the monitor.stem
+configuration, the Cell configuration for Stem::LogTail:
+
+ [
+ 'class' => 'Stem::LogTail',
+ 'name' => 'foo',
+ 'args' => [
+ 'path' => 'tail/foo.log',
+ 'repeat_interval' => 10,
+ 'data_log' => 'archive:bar',
+ 'status_log' => 'archive:bar_status',
+ ],
+ ],
+
+This is the cell responsible for monitoring the indicated log file
+(foo.log). It has arguments for the path to the monitored file, what
+the time interval is (in seconds) to check the file for changes, the
+data log, and the status log. Note that the address of the data and status
+log indicates both the name of the hub that it is located at, as well as, the
+name of the log cell. For more information on these configuration options
+please see the tail log design notes.
+
+Now, lets take a look at the conf/archive.stem configuration file. This
+file defines logical log files (bar and bar_status) that are used by the
+monitor.stem configuration file to log the changes to foo.log.
+
+The first three cells that are configured are the same as the monitor
+configuration, Stem::Hub, Stem::Portal, and Stem::TtyMsg. They are
+for the most part identical. It is worth mentioning here that the
+configuration for the Portal has its server boolean flag set to true,
+indicating that this portal will be awaiting connection requests from
+remote Portals anywhere on a network.
+
+The next three are the configurations for Stem::Log logical logs. The
+first one is a typical logical log file configuration,
+
+ [
+ 'class' => 'Stem::Log',
+ 'args' => [
+ 'name' => 'bar',
+ 'path' => 'tail/bar.log',
+ 'filters' => [
+ file => 1,
+ forward => [ 'bar_stdout' ],
+ ],
+ ],
+ ],
+
+This is defining a logical log named "bar" that is associated with
+a real log file indicated by the path, "tail/bar.log". It also
+has a filters argument that allows Stem::Log::Entries to be filtered
+before they are placed in the log file. The first of the filter
+operations in the above configuration, 'file', indicates that the
+incoming log entry should be placed in the file indicated by the 'path'
+argument. Another one of these filter rules, 'forward, indicates that
+the log entry is always forwarded to the log 'bar_stdout'.
+
+
+The next Stem::Log configuration defines a logical log that conditionally
+outputs its entries to STDOUT. It will write log file entries to STDOUT
+if the 'bar_stdout' Stem environment variable is set to be greater than
+the severity level of the log entry.
+
+ [
+ 'class' => 'Stem::Log',
+ 'args' => [
+
+ 'name' => 'bar_stdout',
+ 'format' => '%f [%L][%l] %T',
+ 'strftime' => '%D %T',
+ 'filters' => [
+ 'env_gt_level' => 'bar_stdout',
+ stdout => 1,
+ ],
+ ],
+ ],
+
+This configuration specifies a format (overriding the default raw format
+like bar.log) that displays the entry with timestamps, label, and level.
+This allows you to customize your log entries to your liking.
+To demonstrate the severity level detection, do the following at the
+Stem prompt in the archive hub window (upper left),
+
+bar_stdout=8
+
+This will ensure that if the severity level of the incoming log entry
+is less than 8, it will be displayed to standard output. now, append a
+line to the foo.log file in the command line window,
+
+echo 'hello log' >> foo.log
+
+You will see in the archive hub window a log message appear in stdout
+in 10 seconds (according to this configuration),
+
+02/11/02 14:27:15 [tail][5] hello log
+
+This log entry is in raw format, the other Stem::Log configurations add
+formats (as mentioned above). For more information on the format of the
+log entries and filters please take a look at the log design notes.
+
+The final cell configuration is for filtering the status messages from the
+LogTail Cell,
+
+ [
+ 'class' => 'Stem::Log',
+ 'args' => [
+
+ 'name' => 'bar_status',
+ 'path' => 'tail/bar_status.log',
+ 'format' => '[%f]%h:%H:%P - %T',
+ 'strftime' => '%T',
+ 'filters' => [
+ file => 1,
+ 'env_gt_level' => 'bar_status',
+ tty_msg => 1,
+ ],
+ ],
+ ],
+
+As you can see, it has the same format as the previous Stem::Log
+configurations. This configuration has both a logfile (tail/bar_status.log)
+and the ability to display the status message if the severity level is less
+than the Stem environment variable 'bar_status' to the tty message
+console (indicated by the tty_msg filter operation, which is set to true).
+Note that tty_msg is different than stdout, the message is being sent to
+the TtyMsg module for output to the console versus just using stdout
+directly. There are also other actions including custom ones.
+
+Let's see this in action, close the three widows created from the tail_demo
+script and re-run tail_demo. do the following at the
+Stem prompt in the archive hub window,
+
+bar_status=8
+
+This will ensure that if the severity level of the incoming log entry
+is less than 8, it will be displayed to standard output. now, append a
+line to the foo.log file in the command line window,
+
+echo 'hello again log' >> foo.log
+
+You will see in the archive hub window a log message appear in stdout
+in 10 seconds (according to this configuration),
+
+[21:58:04]trichards-linux.alias.net:monitor:/opt/bin/run_stem - LogTail: first open of /opt/bin/tail/foo.log
+
+
--- /dev/null
+This module will be on the server:
+SNMP Trap Support (sending and/or receiving)
+-----------------
+Net::Snmp
+--supports v1 and v2
+--can be made non-blocking via new...-nonblocking
+--default is to block
+
+These modules would be run on each client based on a config file
+of sorts.
+
+User Logins
+-----------
+something to read a variant of /var/log/lastlogin, wtmp,etc
+we can do this because the files are usually a fixed binary format
+
+Drive Space Monitoring
+----------------------
+File::df
+
+--requires: statfs()
+--statfs() can be prevented by blocking (on bsdi at least)
+--works with, solaris, sunos, hp/ux, osf/1, linux
+
+
+Running process monitor
+-----------------------
+Proc::Processtable
+--requires: File::Find, Storable
+--works with: Linux, Solaris, aix, hp/ux, fbsd, irix, osf, bsdi, nbsd
+---Watchdog::Process says
+# This class is unreliable on Linux as
+# Proc::ProcessTable::Process::cmndline() sometimes returns undef.
+--hrm...does this mean Proc::Processtable is broke?
+
+Load monitoring
+---------------
+Unix:Processors, gives info of whether a processor is online
+ how many processors, speed of each processor
+
+Sys::CpuLoad
+--works with: any os that has /proc/loadavg or system call
+ equivalent of /usr/bin/uptime
+
+Log File Monitoring
+-------------------
+File::Tail
+--I'm sure this one blocks...duh...but it can be changed
+--but this is very useful for monitoring purposes (see swatch for an example)
\ No newline at end of file
--- /dev/null
+ Stem Architecture Notes
+
+Stem is a network application development toolkit and a suite of network
+applications. Its goal is to transform common network tasks from
+programming to configuration and to make solving difficult network tasks
+much easier.
+
+A running Stem system on a network consists of one or more
+interconnected Stem daemons which are called Hubs. Each Hub contains a
+collection of modules and objects which are called Cells. Stem Cells are
+capable of sending and receiving messages to any other Cell in the Stem
+system. Modules and Cells are loaded or created in a Hub by using
+configuration files. Configurations can be loaded and sent to any
+connected Hub where they will be executed.
+
+Stem's core set of modules provide all of the common operations needed
+including message passing, interprocess communication, asynchronous
+buffered I/O, socket connections and timers. Other modules which can be
+loaded and configured, perform such tasks as process creation and
+management, log file management, gateways, protocol support, message
+switching, etc...
+
+Configuring Stem Cells has been designed for simplicity and
+flexibilty. All Cells use a common style of attribute/value pair
+arguments with well chosen default values which make common situations
+easier to configure. Many example configuration files come with Stem as
+well as demonstration scripts which run working applications such as
+inetd emulation, log file transferring and chat servers.
+
+Stem Messages are how Cells communicate with each other. Their names
+are an ordered triplet: Hub, Cell and Target. Each Cell registers itself with
+a unique name and optional Target name in its Hub. All Hub names in a
+Stem system must be unique too, which makes the address triplet
+sufficient for any Message to be directed to any Cell.
+
+For more detailed information on the architecture and design of Stem,
+read the other technical notes.
--- /dev/null
+ Stem::AsyncIO Design Notes
+
+The Stem::AsyncIO module provides a buffered I/O interface to sockets
+and process handles. It is used by a variety of modules such as
+Stem::Proc, Stem::SockMsg, Stem::Portal::Stream to do the common
+function of doing their buffered I/O.
+
+The constructor takes an owner object and up to 3 handles: input, output
+and stderr (for processes). The input and stderr handles are monitored
+with read events and when data is available, it is read and a callback
+is made to the owner object with the data as its argument.
+
+The write handle is fully buffered and the module provides non-blocking
+asynchronous output to it. Data to be sent to the handle is passed in
+with the write method. If there is any output data buffered, a write
+event monitors the handle and triggers a callback when data can be
+written to it. The callback writes as much data as possible to the write
+handle.
+
+If the read or stderr handle is being used and it is closed (the socket
+is disconnected or the process exits), this is detected and a callback
+to the owner object is made.
+
+This module is only used internally and should not be configured.
--- /dev/null
+
+ Stem Cell Design Notes
+
+Stem Cells are the fundamental working unit in a Stem application.
+Cells are Perl objects that have 3 primary characteristics: First, they
+must be registered with a Stem address. Second, they must have public
+methods that can take an incoming message as an argument. And third, a
+cell must be able to generate messages. There are three major types of
+Stem Cells: class, object and cloned Cells. These are described in
+further detail below.
+
+Class Cells are created by a Stem class which registers itself (using
+the Stem::Route::register_class routine at module load time) and are
+always registered using its class name. Class Cells are typically
+created by modules which manage some global resource and don't need to
+have multiple object instances created. A common reason for this is a
+module which has a 'status_cmd' (or similar) method that is used to
+get the status of the whole module. The Class Cell registration makes
+those methods accessible via messages. Some Stem classes such as
+Stem::Conf, Stem::Portal, Stem::Msg are Class Cells. Some modules can be
+a Class Cell and also create Object Cells. Class Cells can optionally
+be registered with aliases. The aliases make it easier to send a command
+message from the terminal (using Stem::TtyMsg) to a class Cell
+(Stem::Route is aliased to 'reg', Stem::Cron is aliased to 'cron').
+
+Object Cells are objects that are created by a class's constructor and
+are then registered with the Stem::Route::register_cell routine. The
+registration takes the object and a required name (unique to this Hub).
+Most often an Object Cell is created by a configuration but any module
+can construct an object and register it. Since configurations can be
+loaded from files and executed anywhere, Stem Cells can be configured at
+any time during the existance of the current Stem system.
+
+Cloned Cells are only created by existing parent Object Cells. (Parent
+Cells are Object Cells set up to create Cloned Cells). When the parent
+Cell gets some form of trigger (typically a socket connection or a
+special command message), it makes a clone of itself and does whatever
+special work the cloned object needs. The parent Cell owns a Stem::Id
+object which it calls to generate a unique (within this Cell) Target
+name which it uses to register the cloned Cell. So the new Cell has a
+unique Cell/Target name pair which can be used in messages directed at
+it. In a typical case, the new Cloned Cell will send a message elsewhere
+informing some other object about its existance; e.g., The Stem::SockMsg
+class can be configured to clone itself when a socket connection is made and
+then it will send a 'pipe_start' command message out. In an Inetd
+configuration that message would be directed to a parent Stem::Proc
+Object Cell which will clone itself and fork a process. This clone will
+respond to the SockMsg message with its new target address, thereby
+setting up a Stem pipe between the socket and process. When either the
+process exits or the socket is closed, the cloned Cells are notified and
+they clean up and unregister themselves.
+
+You can always find the current set of Cells in a Hub by sending a
+'status' command message to the Class Cell Stem::Route. This is also
+registered with the alias of 'reg'. So from the terminal (if your Hub
+has configured in Stem::TtyMsg) you can type:
+
+reg status
+
+to get the registered Cells in this Hub or
+
+:hubname:reg status
+
+to get the Cells in a remote Hub.
+
+
+When a Stem message is delivered in a Hub, its 'to' address is looked up
+in the Hub's registry and the message is delivered to the destination
+Cell via a method. A Cell must have some well known methods that handle
+incoming messages. These method names have well defined formats and
+uses. In general there are three groups of incoming message methods. All
+of these delivery methods get passed the message itself as their sole
+argument.
+
+The first group of delivery methods are those that handle command
+messages. These are named for the command (the 'cmd' field of a command
+message) with '_cmd' appended. So a foo command message will be
+delivered to the foo_cmd method if it exists in the destination Cell. If
+a command message method returns a value, it is automatically sent back
+to the originating Cell in a response message.
+
+The second group handles all other message types. They are named for the
+message type with a suffix of '_in'. So a 'foo' type message would be
+delivered to the 'foo_in' method if it exists in the destination Cell. A
+very common message type is 'data' and it gets delivered to the
+'data_in' method.
+
+The final group has the single method 'msg_in' which is used if no other
+method can handle the message. This is the default message delivery
+method. You can have a Cell with just this method and it should be
+designed to handle all expected message types.
+
+The use of specific delivery methods is not critical but it encourages
+cleaner Cell design by having methods focus on doing work and not on
+deciding how to handle different message types. This is in keeping with
+the Stem design philosophy of doing as much common work as possible
+behind the scenes, while leaving only the problem specific work to the
+Cell.
+
+There are no design considerations for sending messages from a Cell. It
+just creates a message object with the class call Stem::Msg->new and
+then dispatches it. If the message doesn't have the 'from' address set,
+it will default to the address of the current Cell (if it is known). If
+the code that generates a new message is not a registered Cell, then you
+must specify the 'from' address as one can't be deduced.
+
+For more on Cell addresses see registry_notes and message_notes.
--- /dev/null
+
+ Stem Object and Cell Creation and Configuration Design Notes
+
+All Stem cells and objects share the same API style in their constructor
+methods (commonly 'new'). All parameters are passed as key/value
+attributes and processed with Stem::Class::parse_args which is driven
+with a simple table of field descriptions. Each field is described by an
+anonymous hash with attribute/values. Each allowed field must have a
+name and it also can have several optional description attributes. Here
+are the supported field description attributes:
+
+ name The value of this is the name of this
+ field. Obviously the field name is required.
+
+ required This is a boolean value that says this field
+ is required. If it is not set in the constructor
+ call, an error string is returned.
+
+ default The value for this is the default for this
+ field. It is used if this field is not set in
+ the constructor.
+
+ class The value for this is a Stem class (Perl
+ package) name. It means the value of this
+ parameter will be parsed as the arguments to the
+ constructor ('new' for now) of that class. The
+ object returned is saved as the value of this
+ field. If the called constructor returns an
+ error string, it is returned.
+
+ class_args The value of this is an anonymous list
+ of attribute/value pairs for this class
+ field. They are passed after the caller's
+ arguments and so will override any duplicate
+ passed in parameters.
+
+ callback The value of this is a code reference which is
+ called to do custom construction of this
+ field. The code ref is called with the new
+ object, the field name and the anonymous
+ reference which has the field's passed in
+ values.
+
+ type The value for this attribute is the type of the
+ field. Currently unsupported, it is meant for
+ stronger type checking of parameters such as
+ booleans. This will be supported soon.
+
+ env The value for this attribute is a name of a Stem
+ environment variable. If this name is found in
+ %Stem::Vars::Env then the value in that
+ hash is used as the value for this
+ attribute. This overrides any value passed in
+ the the constructor or a default option.
+ NOTE: Stem environment variables can be set from
+ many places including the command line, the
+ shell environment, command messages and the terminal.
+
+Here is a typical constructor from the Stem::Log class. It has 3 fields
+of which the first is required the other two have defaults. The
+beginning of the constructor sub is shown below and that same two lines
+of code is used in almost every class constructor.
+
+
+my $field_info = [
+
+ {
+ 'name' => 'log',
+ 'required' => 1,
+ },
+ {
+ 'name' => 'level',
+ 'default' => 'info',
+ },
+ {
+ 'name' => 'text',
+ 'default' => '',
+ },
+
+] ;
+
+sub new
+
+ my $self = Stem::Class::parse_args( $field_info, @_ ) ;
+ return $self unless ref $self ;
+
+
+Object Creation Error Handling
+
+Stem cells and objects are being created all the time and in many
+ways. There is a standard way Stem constructor subs return errors. If the
+object construction works, it returns the object. If there is an error,
+it returns the error string. The caller must test constructor
+returns with ref to see if they worked. This makes it easy to pass back
+error messages to higher level objects with this code shown above.
+
+The first line parses the passed arguments (in @_) with a field
+description table. The second line tests if an object was created. If it
+was (ref $self is true), then the constructor continues. Otherwise, the
+error string is just returned to the caller. So the exact low level
+error is propagated up the call tree. This is used consistently in all
+of the constructors so even if you have a class which has a field which
+is a class (see the 'class' field type above), and it has a parse error,
+that error will be passed all the way up to the highest level call
+(typically in the Stem::Config module).
+
+Stem Cell Configuration
+
+Stem cells are typically created by the Stem::Conf class. The primary
+source of configuration data is from a file and that is handled by the
+load method. Currently config files are legal Perl and are just parsed
+with string eval. (Don't yell, I know it sucks but it is simple to
+bootstrap.) The next revision of this module will tighten up the
+specifications of config files and create a proper parser for it. The
+parser will probably use Parse::RecDescent (written by our advisor
+Damian Conway who will probably write the parser for us :). The config
+syntax will probably be similar to what it is now, but barewords
+(actually any token without whitespace) will be allowed anywhere. Only
+value strings with white space will need to be quoted. Config keywords will
+always be barewords. Fat comma will be supported and [] will demark
+lists of anything. There won't be any hashes since this is really just a
+mass of initializations and a list is fine to initialize a hash.
+
+A Stem cell configuration is comprised of a list of attribute/value
+pairs. You can also have a list of cell configurations in one file,
+but each configuration is handled independently. Each configuration
+entry has only a few options in the usual format of key/value pairs. The
+first is 'class', which is required and it names the Stem class which
+will be configured. The next one is 'name' and it is optional but almost
+always used. It is the name that this cell will be registered as and
+that is the address that will be used to send messages to this cell. The
+last major option is 'args' and its value is a list of attribute/value
+pairs used to initialize the cell. Which set of configuration options
+is what controls how a cell is created and/or registered.
+
+The 'class' option is first processed and if it is not loaded, Stem will
+load it for you. This can be done remotely which allows for a servlet
+style of behavior, i.e. a request can come in and be a configuration or
+converted to one and the required Stem class will be loaded and a cell
+created. That cell can then be passed a message and respond to it. All
+of that can occur at runtime on demand.
+
+If the 'args' option is set, then a constructor of the class is called
+and it is passed the attribute/value pairs from the list value of
+'args'. The constructor method is defaulted to 'new' but that can be
+overridden with the 'method' option. The constructor processes its
+arguments (most likely using the Stem::Class::parse_args routine
+described above) and has 3 possible return values. If it returns undef,
+nothing more is done by the Stem::Conf module for this configuration. If
+a string is returned, that is assumed to be an error message and it is
+either printed or returned to the originator of this configuration. Any
+other configurations in this file (or passed in remote configuration)
+are skipped. If the retun value is a ref, then it is assumed
+to be an object and it can be registered with the address in the 'name'
+option.
+
+If the 'name' option is set, that will be used to register the cell or
+class itself. In most of the configuration cases, an object is created
+by the class constructor with the 'args' option and it is then
+registered as a cell with that name for its address. If no 'args'
+option is set, then the class itself is registered under the 'name'
+value and it is a class level cell. There can only be one class level
+cell for any class although it could be registered under multiple names
+(aliases). In addition, the value of the 'name' option is passed along
+with the 'args' values to the constructor as the attribute 'reg_name'.
+
+Here are some example classes which are configured in several of those
+ways:
+
+The Stem::Hub class needs to be initialized with a registration name
+but has no other attributes. So its configuration has a 'name' and an
+'args' option whose value is an empty list (that forces the constructor
+to be called).
+
+ [
+ class => 'Stem::Hub',
+ name => 'server',
+ args => [],
+ ]
+
+The Stem::TTY::Msg class configuration doesn't use the 'name' option and
+it used an empty 'args' value. So its constructor is called and it
+returns its single class level object, and that is registered under its
+class name.
+
+ [
+ class => 'Stem::TTY::Msg',
+ args => [],
+ ]
+
+
+The Stem::Demo::Cmd class is a class level cell that just has a 'name'
+option in its configuration and that is used to register the class
+itself.
+
+ [
+ class => 'Stem::Demo::Cmd',
+ name => 'cmd',
+ ]
+
+
+The Stem::Sock::Msg is configured in the most common way, with 'name' and
+'args' options and values for the arguments.
+
+ [
+ class => 'Stem::Sock::Msg',
+ name => 'C',
+ args => [
+ port => 6668,
+ server => 1,
+ data_msg => [
+ to_cell => 'sw',
+ to_target => 'c',
+ ],
+ ],
+ ]
+
+
+Normally a single configuration file is loaded by the run_stem program
+at start up time. The Stem::Conf module also supports loading a
+configuration file via a command message or another configuration (which
+is similar to include files or Perl modules). A configuration which
+loads a configuration file can evaluate in the current Hub or send it to
+any Hub in the Stem system. This allows for centralized management of
+Stem configurations. As an aid to this, the stem_msg program can be used
+to send a 'load' command message to a Hub.
+
--- /dev/null
+
+ Stem::Console Design Notes
+
+The Stem::Console is a class Cell which provides a simple command line
+interface to a Stem Hub. It parses lines typed into stdin and creates
+and dispatches command type Stem Messages from them. It also can accept
+and print response messages sent back by the command method in the
+addressed Cell.
+
+This class Cell is registered under its class name and with the
+nicknames console, cons, and tty. It takes no configure arguments and
+it just creates an Stem::AsyncIO object to handle the console I/O.
+
+When you see the Stem> prompt, you can enter 'help' to see how to enter
+messages and commands.
--- /dev/null
+
+ Stem Cron System Design Notes
+
+Stem::Cron is designed to both supplant the standard OS cron and
+extending it to support more useful time filters. The key difference
+from the OS cron is that Stem::Cron sends a Stem message when it is
+triggered instead of running a process. This message can be addressed to
+any cell on any Stem hub and so it can cause any action to occur. To
+emulate the OS cron, all the message needs to do is to trigger an
+addressed Stem::Proc cell to spawn a process.
+
+
+
+Stem::Cron entries are similar to the OS cron. You can select a set of
+time parts (minutes, hours, dates, months, days of week) to trigger the
+entry and each part is a list which filters the triggers. Each minute
+(run by infinite repeat timer) the list of cron entries is scanned. If
+the current broken out time matches one corresponding value in each of
+the parts of the entry, then the entry is triggered and its message
+is dispatched.
+
+The cron entry is configured with name/value pairs which are the time
+parts and the set of which values to trigger on in that part. If a time
+is not specified, it is assumed to match all values for that time part
+(like * in crontab). These two differences already make Stem::Cron
+easier to configure than crontab. In addition, each Stem::Cron entry
+must have a message value. This is sent when the cron entry passes all
+of its time filters and gets triggered. The message can be any type,
+carry any data and be addressed to any cell in the Stem network.
+
+Beyond the simple time filters of crontab, Stem::Cron allows you to
+specify complex date descriptions such as last date of the month, first
+weekday of the month, 2nd Thursday of the month, etc.
+
+Another feature I am looking at is not well defined but i have a use for
+it. The log filters want to have a time based toggle so for example, you
+can enable/disable sending logs to a pager at night by sending it the
+right messages. By attaching those messages to properly configured cron
+entries, you have automated managing the times when the log filter is
+enabled/disabled. But there are several open design issues. First, what
+is the initial boolean state of the log time filter? Maybe we should make
+another boolean attribute: time_filter_enabled => 1. Then how often do
+you send the boolean toggle messages? A normal cron time range would
+send messages every minute from enable to disable time (huh?). or we can
+just send the disable message on one tightly defined cron entry and the
+enable on another. The initial boolean state is used and that will keep
+the log filter in the right state. This time controlled boolean toggle
+is a useful idea we can apply elsewhere. A module just for managing
+these things could be a good idea. It would, of course, use Stem::Cron,
+but it could be specialized in setting the cron entries up and other
+stuff.
+
+Right now, Stem::Cron entries are only created in configuration
+files. Creating remote entries would just require sending a config via a
+message to the global Cron cell.
+
+Stem::Cron is a high-level layer above Stem::Event timers. The major
+difference is that Stem::Event only uses callbacks, whereas
+Stem::Cron only sends out messages. Also, Stem::Cron has a much more
+powerful and flexible API for specifying the timing of these messages.
+
+Besides the emulation of the standard OS cron, Stem::Cron can send
+out a message at a repeated interval which has a resolution of
+seconds.
+
+TODO
+
+more testing
+
+fancy time parts. i have developed perl code that calculates most of
+those dates so it should be simple to port the logic over to stem.
+
+timed boolean triggers needs more design work and then coding.
+
+Sending remote configs has not been developed yet but should be done
+soon. should be generic and go into the Stem::Config module.
+
+
+
+
--- /dev/null
+ Stem::Debug Design Notes
+
+Stem modules have a need to report error conditions and trace critical
+events while being able to control when, where and how this information
+is presented. The Stem::Debug module provides a way for any Stem module
+to create debug/trace subs customized to that module's needs.
+Stem::Debug delegates all of this backend filtering, formatting and
+distribution of these messages to the Stem::Log subsystem. In effect,
+Stem::Debug creates specialized front ends subs to Stem::Log.
+
+Using Stem::Debug is very simple. A module just does a use Stem::Debug
+statement with optional key/value parameters. More than one use
+statement can be made in a module and each one will create a new debug sub
+inside that module's namespace. When you create this sub, you can select
+its name, which logical log the message goes to, and the label and severity
+levels. Also a command line argument name may be specified for filtering
+even before the log entry is generated.
+
+The final design of the Stem::Debug is still in flux. It is not yet
+ready to be used by external developers.
+
+This module is only used internally and should not be configured.
--- /dev/null
+
+ Stem Environment Notes
+
+The global hash %Stem::Vars::Env is used to store environment values for
+the local Hub. These values can be set in a variety of ways:
+
+ Shell environment variables of the form STEM_* are located and
+ the STEM_ prefix is removed and the rest of the name is lower
+ cased. This name is set to the value of the shell variable.
+
+ The command line of run_stem is parsed for name=value tokens. The
+ name/value pair is set in the Stem environment.
+
+ The Stem::TtyMsg module parses its input lines for name=value
+ lines (only if the line doesn't contain a leading Cell address).
+ White space is allowed around each part and surrounding white
+ space is stripped from the value. The name/value pair is set in
+ the local Stem environment.
+
+ The Stem::Vars Class Cell (aliased to 'var') can take a
+ 'set_env' command message. The data field is parse for
+ name=value just like Stem::TtyMsg does. This can be used from
+ the terminal of any Hub running Stem::TtyMsg to set environment
+ variables in any Hub.
+
+The environment values are accessable in several ways:
+
+ A Stem module can import %Stem::Vars::Env via a use Stem::Vars
+ statement. The %Env hash can be directly used.
+
+ The Stem::Vars Class Cell supports a 'get_env' command message
+ which uses the data field and the environment variable name. It
+ returns its value via the normal command/response message
+ mechanism.
+
+ The Stem::Vars Class Cell supports a 'status' command message
+ which returns a printout of the entire Stem environment for this
+ Hub. It returns that via the normal command/response message
+ mechanism.
+
+Here are some of the places and ways Stem Environment variables are
+used:
+
+ An attribute description can specify an environment variable
+ name (via the 'env' option). If this environment variable is
+ found it will be used as a default value for this attribute
+ overriding the default option value if it was supplied
+ too. A passed in value will set the attribute regardless of the
+ environment.
+
+ Logical Logs use environment variables to test whether a Log
+ Entry is filtered. The value of the variable is compared to the
+ Entry severity level with any one of the normal numerical
+ boolean tests and it sets the filter flag accordingly.
+
+ The Debug/Trace subsystem uses environment variables in a way
+ similar to the Log subsystem. When a Debug routine is created,
+ an enviroment name can be set and its value is used as a boolean
+ to determine if this call to the Debug sub will happen.
+
+Stem environment values are (and will be) used in many places. If you
+use them in configurations or in code, be sure that the names used are
+unique.
--- /dev/null
+
+Events
+
+The low-level core of a Stem hub is an event-loop engine. This
+engine provides support for the common events needed in a networking
+system, including reading and writing, socket connection and
+acceptance, and timers. The Stem::Event system provides a high-level
+API to these services to the rest of the hub while it, in turn,
+relies on a lower-level event system which is currently Event.pm,
+which is available on CPAN. This design isolates the actual event
+engine used from the cells which need its services. There are plans
+to support other event engines including Perl/Tk, and creating one
+that runs on NT/Win2K.
+
+Stem::Event uses the standard Stem callback style which requires
+parameters designating the object and method to call when an event
+has been triggered. In typical Stem fashion, the method names have
+useful defaults so a Stem::Event call is made with very few
+parameters.
+
+Read and write Stem events take a required object and filehandle as
+parameters, and an optional timeout value. If the I/O is not
+completed before the timeout occurs, the timeout method is called
+instead of the normal I/O completion method. The connect and accept
+events also require an object and the appropriate socket parameters.
+The connect event can take an optional timeout which behaves
+similarly to the read/write timeout. A timer event can be created
+which will be triggered after a given delay and optionally repeated
+at a specified interval. As you would expect in an event system,
+multiple instances of all these events can be active at the same
+time.
+
+Most cells will never directly use the Stem::Event interface as there
+are higher level cells that perform commonly needed services for
+them. These include Stem::AsynchIO, Stem::Socket, and Stem::Cron.
+However, this does not stop any cell from directly calling these if
+it needs finer control over its events.
+
--- /dev/null
+
+ Stem::Id Design Notes
+
+The Stem::Id module generates unique Id strings for use as names in Stem
+addresses. Its most common use is by parent Cells which clone themselves
+and need a unique Target. The parent Cell uses its Cell name and the new
+Target to register the cloned Cell.
+
+A typical use is by a Stem::SockMsg Cell which creates a Stem::Id object
+during its own construction. When this parent Cell accepts a socket
+connection, it clones itself and needs to register this new Cell with a
+unique address. The parent Cell calls the next method of its Stem::Id
+object to get a unique Id which is uses for the Target address of the
+cloned Cell. Then the cloned Cell is registered with the parent Cell
+name and the new Target name. This address is then sent to other Cells
+so they can communicate with this new Cell.
+
+This module is only used internally and should not be configured.
--- /dev/null
+
+ Stem Technical Notes
+
+
+Stem Architecture
+
+ This describes the top level architecture of Stem, in particular
+ what its components are (Hubs and Cells) and how they work
+ together.
+
+Stem Cells
+
+ This describes Stem Cells, the primary components of a Stem
+ system. It covers both class and object type Cells, their
+ creation and registration and their method conventions.
+
+Stem Messages
+
+ This describes the content and fields of Stem messages. These are
+ used to communicate between Stem Cells.
+
+Stem Registry and Message Addresses
+
+ This describes how Cells are registered so they can receive
+ messages and the way messages are addressed.
+
+Cell Creation and Configuration
+
+ Stem Cells can be created internally via a constructor or from
+ external configurations. This describes the common systems used
+ to create and register Cells.
+
+Logging Subsystem
+
+ This describes the Stem logging subsystem including logical
+ logs, log files, log filters and how to submit log entries.
+
+Cron Subsystem
+
+ This describes the Stem Cron subsystem and how it can schedule
+ regular Stem message submissions based on time and date.
+
+Stem Events
+
+ This describes the low level Stem Event subsystem including
+ reading, writing and socket events.
+
+Security Notes
+
+ This describes the Stem security model and its features.
+
+
+ Stem Cell and Module Notes
+
+These are some of the Cells and modules in the Stem library. These notes
+will describe what they are, why they are needed and how they are
+used. Also some examples of their use and configuration are given. For
+detailed descriptions of their configuration, attributes, and methods
+see their documentation (available in the source tree or <HERE>)
+
+NOTE to jasmine: when we get the pod generation stuff going soon, we
+will make html versions of the pod docs and web them. they need to be
+linked from each cell tech notes and be in a documentation subdir with a
+nav bar link. this is later but i am just letting you know now.
+
+NOTE: also i am going to list all of the cells here, even if they don't
+have a tech notes page yet. make an empty one for them. we should come
+up with a template for their names, format, etc. i want to drop the
+'notes' part in most cases.
+
+
+Stem::Conf
+
+ This module parses and executes Stem configurations from both
+ local files and sent from remote Stem Hubs.
+
+Stem::Proc
+
+ This Cell forks off and manages external processes. They can be
+ monitored and all their I/O can be easily be integrated with
+ Stem via messages, logs and/or callbacks.
+
+Stem::SockMsg
+
+ This Cell connects to and accepts standard Internet
+ sockets. They can be monitored and all their I/O can be easily
+ be integrated with Stem via messages, logs and/or callbacks.
+
+Stem::Cron
+
+ This module creates and manages scheduled message submissions.
+
+Stem::Log
+
+ This module supports the Stem logging subsystem. It encompasses
+ the Stem::Log::File, Stem::Log::Filter and Stem::Log::Entry
+ classes.
+
+Stem::LogTail
+
+ This Cell monitors an active external log file. It sends new
+ data into the Stem logging subsystem on periodic basis or on
+ demand.
+
+Stem::Switch
+
+ This Cell is a general purpose Stem Message multiplexor.
+ Messages directed to this Cell can be
+
+Stem::Debug
+
+ This class is used to create standard and customized debug and
+ trace subs in any Stem module. The used
+
+Stem::Id
+
+ This class is used to create ID's for dynamically created
+ Cells that need unique addresses.
+
+Stem::Portal
+
+ This class creates and manages connections between Stem Hubs. It
+ converts Stem Messages to/from a stream format for transmission
+ over the connection.
+
+Stem::AsyncIO
+
+ This class is used by other Cells to create and manage buffered
+ I/O streams to sockets and process handles.
+
+Stem::Socket
+
+ This class is the low level API to create socket connections and
+ accepted sockets.
+
+Stem::TtyMsg
+
+ This class Cell is used to provide a TTY interface to a running
+ Stem Hub. Stem command messages can be entered and sent to Cells
+ and their responses are printed.
--- /dev/null
+
+ Stem Logging Design
+
+The Stem logging subsystem is designed to be very flexible, powerful and
+yet simple to use. Log data comes into the system via a Log Entry which
+is submitted to Logical Logs. Entries can be submitted to multiple
+Logical Logs which can be local to the current Hub or on remote
+Hubs. Each Logical Log processes the Entry which can be filtered,
+redirected and written to physical log files. Logical Log filter rules
+can match the text or label with regular expressions, test the range or
+value of the level, check the time of day or do any boolean combination
+of those. If an Entry passes a set of rules, then it is passed to a set
+of actions which can execute a wide range of operations upon it
+including printing the entry to a file, sending it via email or to a
+pager, printing it to stderr, or the entry can be forwarded to other
+Logical Logs. The full set of filter rules and actions are described
+below.
+
+Log Entries are constructed with the 'new' method of the
+Stem::Log::Entry class. The caller can set the entry's text, label, and
+a severity level and the timestamp is automatically stored in the
+entry. If any Logical Logs are specified the entry is submitted to
+them. In any case, the entry object is returned and it can be submitted
+to Logical Logs with its submit method. The class Stem::Log::Entry is
+registered as a Cell so Log Entries that are forwarded from remote Hubs
+can be handled by this class. Log Entries can be created by created and
+submitted by code anywhere in Stem. Many Cells can be configured to
+submit Log Entries which contain data or status information. The
+Debug/Trace subsystem also generates Log Entries as do any monitoring
+modules such as Stem::LogTail.
+
+
+A Logical Log is constructed by the 'new' method of the Stem::Log
+class. They are typically created by external configurations but some
+modules create them internally for their own use. Each Logical Log on a
+Hub must have a unique name and that is the name used to submit Log
+Entries. Remote Logical Logs are referred to by a string of the form
+'Hub:LogName'. Any place where you can specify a Logical Log name, you
+can also use a remote Log name.
+
+When a Log Entry is submitted to a Logical Log it gets filtered and
+processed. The Logical Log is configured with optional physical file and
+filter attributes. If there is no filter in a Logical Log, its default
+is to print any submitted Entries to its file (if there is one). Logical
+Logs don't need to have a physical file attribute as they can filter and
+print their Entries to many other possible destinations (see below for a
+list of actions and Entry destinations).
+
+The 'path' attribute of a Logical Log specifies its file. Other
+attributes control the long term management of the file. They include
+when to rotate the log file, the format of the timestamp suffix of the
+rotated files, any compression to be performed, where to move archived
+logs, eternal programs to be called to process the log file, etc. These
+log file handling attributes and their code support are under development.
+
+The filter attribute of a Logical Log consists of a set of key/value
+pairs which are called filter operations. When an Entry is submitted to
+a Logical Log which has a filter, a private hash copy of all of its data
+is made and a special boolean called the filter flag is set in that
+hash. All of the filter operations are processed sequentially and work
+with that flag. The operations can be grouped into 3 types, flag
+operations, rules and actions. Flag operations directly modify the
+filter flag and its behavior which is used to control the rules and
+actions of this filter. Rules are boolean tests that check the submitted
+entry for some condition and can set or clear the filter flag. Actions
+print or forward the submitted Entry only if the filter flag is
+currently true. The filter flag is initialized to true so all actions
+and rules will be executed until some rule or flag operation clears it.
+
+Flag operations are always executed regardless of the current value of
+the filter flag. The current value of the filter flag can be set,
+cleared or inverted. Also the boolean operation that is used with the
+rules can be selected. It defaults to 'and' which causes each rule's
+boolean result to be 'and'ed with the filter flag and stored there. If
+the flag operator is set to 'or', then the rule result is or'ed with the
+flag and stored back into it. The boolean test of the filter flag can be
+inverted with the 'invert_test' flag operation. By combining the flag
+operations and the negated prefix of rules (see below) you can get any
+boolean combination of rules. If you want multiple sets of rules each
+with their own set of actions in a filter, just set the filter flag to
+true before each set of rules and follow them by their associated
+actions. If you want to execute some actions if any of a set of rules is
+true, set the filter flag to false, set the flag operation to 'or' and
+set the test to inverted. The next rules will execute since the test in
+inverted and the flags is false. If any rule returns true, it will will
+set the flag since it is 'or'ed with it. The rest of the rules will be
+skipped. Then the normal_test operation should be executed. The actions
+that follow will only be executed if any rule was true.
+
+Filter rules are only executed if the filter flag is currently true (or
+false when the inverted_flag operation is in effect). Each filter rule
+name can be prefixed with 'not_' which will invert the results of the
+rule. There are many builtin rules which are grouped into three
+categories. The first group matches either an Entry label or text with a
+regular expression. The second group compares the Entry severity level
+with an integer. The third group compares the Entry severity level with
+a global value in the %Stem::Vars::Env hash. Those hash values can
+be set on the command line, from environment variables and by code. This
+allows for fine control of how Entries get filtered by level. Examples
+of using that facility are to enable debug/trace calls to output to
+stderr or be forwarded to a remote Logical Log.
+
+Filter actions, like filter rules are only executed if the filter flag
+is currently true (or false when the inverted_flag operation is in
+effect). But actions cannot affect the value of the filter flag and are
+meant to send Log Entries to different destinations. The builtin actions
+can print Log Entries to stdout, stderr or the controlling TTY. Entries
+can be emailed, sent to a pager, written to the console with the wall or
+write commands, or forwarded to other Logical Logs. Of course they also
+can be written the to physical file associated with this Logical Log.
+
+WARNING: Currently forwarding loops can be created with Log filter
+actions. There are plans to detect them with either storing in the Log
+Entry a hop count or a history of which Logical Logs it has seen.
+
+Custom filter rules and actions can also be created. Any module can have
+them and they are called by their name which is the value of the
+'custom' operation. The difference between a custom rule and action is
+that the rules return a defined boolean value while the actions return
+the undefined value (a plain return does that).
+
+When a Log Entry needs to printed by an action (which all builtin ones
+except forwarding does), it must format the Entry. This is controlled by
+the 'format' attribute of the Logical Log. The format value is similar
+to sprintf and uses % as a field marker. It can print the Entry text
+(%T), label (%L), level (%l), timestamp (%l) and original Logical Log
+name (%N) (so forwarded Log Entries can say where they came from). The
+default Log Entry format is %T which will just print the text. Also the
+timestamp which is normally printed as an integer (Unix Epoch time) can
+be printed with the %f marker in a strftime format. The attribute which
+controls the time format is 'strftime'. The default strftime format is
+%C which will print the time as the command 'date' will.
+
--- /dev/null
+
+ Stem::LogTail Design Notes
+
+The Stem::LogTail module provides a service similar to the standard Unix
+program tail -f. It constructs a Cell that can watch a file for changes
+in it size or inode and then sends the new data to a destination. The
+destination is a Logical Log created elsewhere in the Stem application
+and it can be located on any Hub on the network. Also file status
+changes such as not being found, first time it is opened, it was
+truncated, etc. can be sent to a different Logical Log than the data.
+This module is a critical part of the StemLog application which
+transfers active log files from one system to another.
+
+The action of checking the file is triggered by a call to the tail_cmd
+method. There are two main ways of triggering it, either by an internal
+timer or via a command message directed at this Cell. The timer is
+configured when the Cell is created and its resolution in in seconds. So
+e.g. you can cause a file check to occur every 15 seconds. If a 'tail'
+command message is sent to this Cell, it will also trigger a file
+check. The command message is usually sent from a Stem::Cron entry
+configured elsewhere. In either case new data is sent to the 'data_log'
+Log and status is sent to the 'status_log' Log.
+
+The primary configuration parameter is the path to the file to be
+checked. Also the required 'data_log', optional 'status_log' and
+'repeat_interval' are set in the configuration.
+
+When the file is checked, the current size and inode are compared to the
+previous values. If either has changed, then either data and/or status log
+entries are sent.
+
+NOTE: The modification time of a file is not currently checked for
+changes. The reason is that there is no way to determine if a file
+changed (or what data has changed) if the file just has its modification
+time changed (by touch or utime). This means that there is a weakness in
+just checking for the file size changing. If a file were to be truncated
+and then written to with the same amount of data as it had when it was
+last checked, a tail operation would not report any new data. This bug
+exists in both the GNU and Solaris tail programs. The only way around
+this is to check for modification time changes and trust
+this. Stem::LogTail will support an option for doing this instead of
+checking file size but it is up to the user to assure that the file will
+only change its modification time if its data actually changes. Most
+logs generated by programs have this attribute.
--- /dev/null
+ Stem Message Design Notes
+
+Stem Messages are how Cells communicate with each other. Messages are
+simple data structures with two major sections: the address and the
+content. The address contains the Cell name the message is directed to and
+which Cell to send replies to. The content has the message type, command
+and data. These sections are described below in further detail.
+
+The Message address section has multiple addresses called types. The two
+supported types correspond to the common email headers and are called
+'to' and 'from'. The 'to' address designates which Cell will get this
+message and the 'from' address says which Cell sent this message. Other
+address types which may be supported are 'reply' (which overrides the
+'from' address for replies) and 'orig' which is the address of the
+original Cell which created this message (useful when messages get
+forwarded). Each address type contains the standard Stem Cell address
+triplet of Hub/Cell/Target which are called the address parts. The Cell
+name is required and the Hub and Target are optional.
+
+The Message content has information about this message and any data
+being sent to the destination Cell. The primary attribute is 'type'
+which can be set to any string, but common types are 'data', 'cmd',
+'response' and 'status'. Stem modules and Cells can create any Message
+types they want. If the Message is a 'cmd' type, then the 'cmd'
+attribute must be set to the command. A status type Message requires the
+'status' attribute be set and the 'data' or 'response' types has the
+'data' attribute set (though any message type can send data). There is
+also a special flag attribute called 'ack_req' which forces a 'msg_ack'
+type to be sent back to the 'from' address after this message is
+delivered. One important note about the 'data' attribute, it is always a
+reference and never a simple Perl scalar value. You can send a scalar
+value but only by setting the 'data' attribute to its reference.
+
+Messages are constructed with the 'new' method of the Stem::Msg
+class. Any of the message attributes can be specified in that call or
+accessed/modified with the accessor methods. When a Message is completed
+and ready to be sent, the dispatch method is called and the message is
+queued for delivery. For convenience, the Message address types and part
+can be combined into one attribute name in both the constructor and
+accessors. So the Cell the message is directed at can be set with
+'to_cell' and the Hub it came from can be accessed with 'from_hub'. The
+entire address triplet of an address type can be set or accessed just
+with its type name, so the 'to' address is set or accessed with the 'to'
+attribute or method. It takes or returns a hash of the address parts and
+their values.
+
+Messages are delivered only after the current callback is finished
+executing (remember all code in Stem are called as callbacks). Stem
+Message delivery is the heart of Stem operations and is described in
+detail here. Delivery take place in three phases, the first determining
+which Hub the Message is sent to, the second, which Cell in that Hub
+gets it, and the third, which method in that Cell to call for delivery.
+
+If the Message has a 'to_hub' address, then that Hub name is looked up
+in the Portal (which are Cells which connect Hubs together) registry. If
+a Portal is found, the Message is delivered to it to be sent to the
+destination Hub for local delivery. A Message can be forwarded across
+several Hubs before it gets delivered to its destination Cell. If the
+Hub name is the same as the current Hub or there is no Hub name in the
+address, the Message is delivered to a Cell in the current Hub. In the
+special case where there is no Hub name and the Cell name isn't
+registered in the current Hub, the Message is sent to the Portal with an
+alias of DEFAULT. This is just like the default route in IP routing
+tables. If there is a Hub name and the Cell is not found, then there is
+an addressing error and that is logged and the Message is discarded.
+
+Once a Message's destination Hub is reached, it must be delivered to a
+local Cell. The 'to_cell' and 'to_target' attributes are accessed from
+the message and that pair is searched for in this Hub's Cell registry.
+If there is no Target name in the address, it defaults to the null
+string. If there is a Target and the Cell is not found, the search is
+repeated with no Target name (the Target name will be used by the
+destination Cell). If the Cell still is not found, an addressing error
+will be logged (with the message address) and the Message is discarded.
+
+When the destination Cell of a Message is determined, the method to call
+for delivery must be chosen. The rules for this are simple. If a Message
+is a 'cmd' type, then the method name is made by taking the 'cmd' name
+from that attribute and appending '_cmd' to it. So a 'foo' command
+message will have its type set to 'cmd', the 'cmd' set to 'foo' and it
+will be delivered to the 'foo_cmd' method. If the Message is any other
+type than 'cmd' the method name is created by taking its type name and
+appending '_in' to it. So a 'foo' type Message is delivered to the
+method 'foo_in'. If the delivery method doesn't exist, the default
+method 'msg_in' is used. If no delivery method is found, then an error
+is logged and the Message is discarded.
+
+Command Messages have a useful feature where they can automatically
+generate 'response' messages. When a 'cmd' delivery method is called and
+it returns a defined value, a 'response' type Message is created using
+the 'reply' Message method. This uses the 'reply' or 'from' address in
+'cmd' Message as the 'to' address in the 'response' Message. Its data
+field is set from the data returned from the command delivery
+method. This reduces the work of common command methods to just having
+to return a data value. Many Cells use this technique, e.g. the
+status_cmd method in a Cell just returns the status text of it. The
+delivery mechanism takes that text and creates and dispatches a
+'response' method with the status text as its 'data' payload.
--- /dev/null
+
+ Stem::Portal Design Notes
+
+The Stem::Portal class supports the transmission of Stem Messages
+between Stem Hubs. Portals are based on sockets and are configured very
+similarly to a Socket with host and port attributes. Also a Portal can
+be designated a TCP/IP server or a client. Once two Hubs are connected
+via their Portals, they communicate peer to peer in full duplex mode.
+
+Portals are sent a Message to transmit by the Stem::Msg delivery
+subsystem. The Message is converted to a byte stream format and written
+to the Portal socket. When a Portal reads a byte stream Message from its
+socket, it converts it back to an internal Message and sends it to the
+Stem::Msg class for delivery.
+
+When a Stem Portal connects to another, they both exchange a special
+'register' type Stem Message. This message when received by a Portal is
+trapped and never sent for delivery to the Stem::Msg subsystem. The
+'register' message contains the Hub name of the remote Portal. This name
+is then stored in a registry private to the Portal class. It is used by
+the Stem::Msg delivery subsystem to look up which Portal to use to send
+out a remote message. You can see the current state of the Portal
+registry by sending a 'status' command message to the Portal class. This
+is easily done from the terminal (if the Hub has Stem::TtyMsg
+configured) with the command:
+
+ :port status
+
+If you put a Hub name before the :, you will get the Portal registry
+status of that Hub.
+
+A special alias is set up for a client Portal that is the first one
+configured in a Hub. It is given the alias DEFAULT and this Portal
+becomes the default destination for any Messages that aren't delivered
+locally. So if a Stem Message has no Hub in its 'to' address and the
+Cell name is not registered locally, it is sent to the DEFAULT Portal
+and hence to the Hub it is connected to. This is very similar to the
+default route in IP routers like the routed daemon. A new feature (to be
+implemented soon) will be to allow the setting of the DEFAULT Portal at
+configuration or run time.
+
+Security of Hub to Hub communications are handled by the Portal
+Cells. There are two designs in progress, one which pipes over ssh to
+the other Hub, and an internal encryption module which will perform the
+same functions but be more efficient.
--- /dev/null
+Stem::Proc
+
+A major service in network management infrastructure is running and
+controlling processes. Stem::Proc is a very simple to use cell which
+has a wide range of useful options to control the process behavior
+and its standard I/O. The required parameters to the cell specify
+the program and its arguments.
+
+The first group of configuration parameters controls how and when the
+process is actually started. A process can be started at
+configuration time or initiated by a command message. The message
+interface is very important as it allows process management from any
+other cell, including Stem::Cron (this will allow emulation of the OS
+cron running processes), Stem::SockMsg (this will allow emulation
+of the OS inetd), and other similar needs for remote process
+invocation. Process monitoring is achieved by handling SIGCHLD
+signals and I/O handle shut-down detection. A message can be sent
+upon process exiting and the process can optionally be restarted
+automatically, giving you a watchdog service.
+
+The second group is much larger and controls the I/O behavior of the
+process. You can enable/disable any subset of its
+stdin/stdout/stderr handles. This is needed for processes that don't
+use all of their standard I/O handles. Process I/O can be managed by
+the Stem::AsyncIO class and callbacks. In addition, the cell can be
+configured to transfer its I/O data to/from other cells via Stem
+messages. One neat feature is the ability to buffer all output from
+a process and send it via a message only upon process exit. This
+emulates the running of a process in backquotes as supported by
+shells and Perl.
+
+Processes that need to work with a terminal can optionally be run
+behind a pseudo-TTY device.
+
--- /dev/null
+
+ Stem Cell Registry and Message Address Design Notes
+
+The heart of Stem is the messaging subsystem and the heart of that is
+the registry. This is where all knowledge of how to address cells is
+located. Each cell gets registered by it name and optionally its target
+and messages are directed to it via its names. The decisions made by the
+registry when delivering a message are described here as well as the API
+and other related issues and modules.
+
+
+Stem Message Addresses
+
+Stem messages are sent to registered cells by using an address triplet:
+the hub name, the cell name and the target name.
+
+A hub is a single process running Stem. Its name must be unique among all
+Stem hubs in a single connected net. A hub consists of a set of objects
+and Stem cells. It contains the message registry, the core Stem system
+and it will load other modules on demand.
+
+A Stem cell is a single object in a Stem hub which has registered itself
+under a name and can receive messages via its methods. Not all objects
+in Stem are cells, but all Stem cells are objects. Cells are commonly
+registered by the Stem::Config system or by a parent cell spawning
+targeted cells. Only one cell can be registered in a hub for a given
+cell name. One unusual trick is that a whole class can register itself
+as a cell by using its class name as the object and some fixed string as
+the name (sometimes that is the class name as well). There can only be
+one cell by that class and name but there can be aliases for any cell
+name. That is used by cells which must be implemented with class level
+data.
+
+The target is the last part of an address and is optional. A given cell
+could be registered with a cell name and target and it can send and
+receive messages with its own globally unique address. The cell name is
+either the parent's cell name or a fixed one for the particular class
+(the Stem::Log::Filter class does this). The target name is commonly
+either a Stem::Id value or a name from a configuration. Another use for
+the target is a cell such as Stem::Switch which uses it to address its
+input/output maps. The use of the target is defined by the design of the
+cell.
+
+Message Delivery
+
+The first step in delivering a message is finding out which cell it goes
+to. This is done by looking up the cell that matches the hub/name/target
+address in the message. This is a multistep procedure with the following
+rules:
+
+If the hub name of the message is set and it is not the name of this
+hub, locate the portal that can send to that hub and deliver the message
+to that portal. Portal names are in a different namespace as regular
+cells but portals can also be registered as targeted cells so they can
+have commands sent to them. See more on Portals below.
+
+If the message has a cell name and an optional target name, the cell is
+looked up in the local registry. Cells with just a cell name don't share
+the namespace with cells that have cell and target names. If the cell is
+found the message is delivered by a method. (See how that is chosen
+below.)
+
+If the cell is not found locally it is sent out via a portal with the
+alias DEFAULT. This portal should be connected to a hub which would know
+how to direct the message to the proper destination cell. Typically a
+Stem hub that is a TCP client to a more central server hub will just
+have its portal to the server aliased to DEFAULT.
+
+If the message has the local hub name and couldn't be delivered, it is
+logged and thrown away. Optionally a delivery failure message could be
+sent back to the originator. But this is not the Internet and bounces
+can be automatically fixed in Stem.
+
+NOTE: This brings up the whole subject of message routing. I have been
+thinking about this issue for a while and it is not as tricky as the
+Internet because of several things. First, we can cheat. Stem is
+completely in charge of its routing so it can be smart about itself and
+not deal with worst case situations like the net. A hub can be
+configured to distribute routing information that supports the network
+topology. The discovery of the network and its topology can also be
+automated by a booting Stem network, even from a virgin boot. Remote
+Stem hubs could be installed with minimal (and not customized)
+configurations which will cause itself to connect to a server hub and
+download the real configuration. This simplifies deployment of Stem to a
+new set of boxes. Much more on this subject will be in another design
+notes file.
+
+
+Choosing the Cell Method
+
+Once the destination cell of a message is determined, you then have to
+find out its best method to call to deliver that message. Stem's
+messages can be delivered via a generic method (e.g. 'msg_in') which is
+expected to take any type of message, or via specific methods
+(e.g. 'data_in') which handle selected messages. Here are the rules for
+determining the cell method to call.
+
+If the message type is 'cmd' with a command 'foo' and there is a cell
+method 'foo_cmd', the message is delivered via that method. If a command
+message is delivered via a command method and a value is returned, that
+value is sent back to the 'from' address in a response message.
+
+For all other message types, if the Cell has a method that is the type
+name with '_in' appended to it, that method is used for delivery,
+e.g.; if the message type is 'data', and if the cell has a method named
+'data_in', that is called with the message as its sole argument.
+
+If the message is not delivered by any of those special methods, it will
+be delivered to the generic method 'msg_in'. This method should exist in
+every cell (except those that have the special methods cover all their
+message types). The method delivery lookup simplifies writing Cells by
+moving the internal dispatching code from the Cell to the registry.
+
+
+
+Stem::Id is a simple module designed to manage a set of unique IDs for
+its owner object, i.e.; it is used by the Stem::SockMsg modules
+to register all of its accepted/connected sockets with unique targets.
+
+Stem::Portal is the class that send messages between hubs over
+pipes. These pipes can be direct sockets or indirect through a secure
+transport such as ssh or stunnel. It receives messages vis the 'send'
+method which are then converted to a string form and written out the
+pipe. The stringify format is currently Data::Dumper but it can be set
+via the configuration of the portal to use Storable, XML or something
+else. Each stringified message is prefixed with 1 or 2 lines containing
+its size and format. Incoming message strings are converted back into
+internal messages and then delivered locally by calling dispatch on
+them. Portals can use any communications channel as long as it gets read
+and write handles. This means that new security and transport protocols
+can be integrated easily into the portal.
--- /dev/null
+Security
+
+A critical aspect of any network application these days is security.
+Stem hubs communicate with each other via standard internet sockets.
+This communication can be made secure by tunneling over existing
+open source products such as SSH and Stunnel. Stem runs the security
+program and has it connect with the remote hub and its stdin/stdout
+is used for the local connection. The Stem::Proc cell is used to
+manage this external security program and it provides all the I/O
+support needed. The Stem::Portal cell is used to connect Stem hubs
+together and it has configuration options to select the desired
+security application and options. A Stem hub can listen for portal
+connections using a Listen socket bound to localhost or an IP
+address. By using localhost and a secure transport, a Stem hub
+cannot be accessed by any unauthorized programs.
+
+
+
--- /dev/null
+Stem::Sock::Msg
+
+This cell is the primary way of interfacing external programs to the
+Stem messaging system. It is effectively a gateway with a standard
+socket on the outside and a message interface on the inside. The
+socket side takes standard Stem socket parameters for configuration.
+The message side has a variety of message types and options to
+control buffering.
+
+The socket parameters are directly passed to a Stem::Socket cell, and
+supports both client and server modes. Multiple instances of this
+Stem::Sock::Msg cell are supported and can be created via socket
+connection or acceptance. If a connected socket is externally shut
+down it can optionally be reconnected automatically.
+
+When the socket is connected or disconnected, a status message can be
+sent out. This is used to trigger the addressed cell to be made
+aware of the new socket status and act accordingly. For example, in
+an inetd emulation, the socket connected message would cause the
+address Stem::Proc cell to start a process and logically connect it
+to this Stem::Sock::Msg cell. Similarly, the socket closed message
+would cause the process to shut down and the logical connection to be
+broken.
+
+When data comes in from the socket, it is buffered and sent out via a
+data message to an addressed cell. Optionally, all incoming data can
+be buffered and only sent out in a single message when the socket is
+closed. This reduces the need for some cells to do their own
+buffering.
+
+As with all Stem cells, various status information can be logged to
+logical logs using the Stem logging system. Which status is logged
+can be controlled by the configuration of the cell.
--- /dev/null
+ Stem::Socket Design Notes
+
+The Stem::Socket module provides an interface to create connected
+sockets. It can either connect to a remote socket as a client or listen
+for connections as a server. Its constructor takes an owner object, an
+optional host or IP address and a required port number. Also a boolean
+flag designates whether is it a client or server. If no host argument is
+provided, it will default to localhost. To make a server listen on any
+IP address (with the wild card INADDR_ANY), pass in the empty string ''
+as the host.
+
+When a socket connection is made (either a client or a server), the
+owner object is notified by a callback and the handle of the newly
+created socket is passed to it. Since a client socket can timeout when
+connecting to a server, a timeout value can be set. If the connection
+request times out a different method is used as the callback to the
+owner object.
+
+This module is only used internally and should not be configured.
--- /dev/null
+Stem::Switch
+
+The Stem::Switch cell is a very simple but powerful object which can
+be used in a wide range of applications. Its primary function is to
+receive a message and to copy and redirect it to a list of
+destination cells. It can be used as a multiplexer in many-to-one,
+one-to-many, and many-to-many configurations. Currently it is used
+as the heart of the chat server demo and the Inetd demo.
+
+Stem::Switch has two maps: the input map is used to translate the
+incoming target address to entries in the output map. Each input map
+entry can have multiple output targets and that list can be set via a
+configuration file at start-up time or a command message at runtime.
+The output map just converts the output name to an actual cell
+address and is one-to-one; it also is set via the configuration file
+or by runtime command messages. In addition to the explicit command
+message technique for changing the maps, a publish/subscribe
+interface is supported. A given cell can announce to a Stem::Switch
+cell that it will be publishing messages to a given target address in
+the switch. Other cells can send a subscribe message which will
+cause all messages sent to the selected publish address to be
+forwarded to themselves.
+
--- /dev/null
+What Can I Do With Stem?
+
+You should probably ask, "What can't I do with Stem?" :-). Stem is not
+bound by any narrow niche definition since it is a general purpose
+networking toolkit. As such it can be the backbone of almost any
+networked application. On the other hand Stem is designed with standard
+modules that are aimed at specific application niches. Some Stem users
+want a a way to accelerate network application development and others
+want a simple solution to common problems. Stem can satisfy the
+differing needs of both groups.
+
+What Are the Top Stem applications?
+
+The most commonly requested applications of Stem are log management,
+file distribution, monitoring and remote command execution. For more on
+Stem applications see the <A href="/app_niches.html">niches</A> page.
+
+Why Should I Use Stem?
+
+You should use Stem if you are tired of reinventing the wheel for each
+network application you build. Or if you don't want to be forced to rely
+on a commercial monolithic network tool that everyone hates to use. Or
+if you want to dramatically reduce the development and maintenance costs
+of developing your new network applications. Or if you just want to use
+a well designed network system that will make your profession much more
+enjoyable. Please contact us if you want more reasons.
+
+Who Is Using Stem?
+
+Currently we are developing a Stem based log management system for a
+Fortune 500 company. It will watch growing log files on hundreds of
+systems and transfer the new log records to a central system for
+analysis and archiving. This complex system will use standard Stem
+modules and require only a single customized tool that creates the
+configuration files. Another Internet content provider company we are
+talking to is interested in a similar system. We don't know of any
+products that can manage logs over a network as simply and elegantly as
+Stem.
+
+What Existing Products Does Stem Improve On?
+
+Stem is not a direct improvement of any existing product. Rather it is a
+coherent integration of a range of network services as used by many
+products. Stem did not invent logging, monitoring, process management,
+file transfers, etc, but it has put them together under a simple
+architecture that meets the needs of the technical market. With Stem,
+solving many common network problems doesn't require any coding at all,
+just simple edits to text-based configuration files. Even when coding
+*is* required, Stem allows you to develop and maintain complex network
+applications much more cheaply and reliably than existing application
+frameworks.
+
+Do I Need To Get Rid Of [Commercial App] To Use Stem?
+
+No, Stem can run in parallel with all of your existing applications. As long
+as Stem can have access to its own TCP ports (which can be configured to
+any available ones), it has no need to conflict with any of your current
+systems.
+
+What is a Stem Hub?
+
+A Stem Hub is a single Perl process running Stem. It can function as a
+complete stand-alone application or be connected to other Stem Hubs in a
+networked application. Stem Hubs contain the Stem core system and Stem
+Cells that have been created by configuration files. For more on this
+read the <A href="/tech_notes/arch_notes.html">arch_notes</A> document
+or find it in the Design directory of the tarball.
+
+What is a Stem Cell?
+
+A Stem Cell is a Perl object which has to have 3 major characteristics:
+
+ 1. It has been registered as a Cell in this Hub with a cell name
+ and an optional target name.
+
+ 2. It has to have a set of methods designated to handle messages
+ directed at the Cell.
+
+ 3. It has to be able to send messages to other cells.
+
+What is a Stem Message?
+
+Stem Messages carry commands and data between Stem Cells. They are
+addressed with a Hub/Cell/Target triplet. Messages can be any one of a
+wide range of types including command, data, log, stderr etc. They can
+carry any form of data to a maximum (to be designated later) size. See
+<A /tech_notes/message_notes.html">message_notes</A> document for more.
+
+How Hard Is Stem To Install/Configure?
+
+Stem is very easy to install. It only requires Perl 5.005_03 and one
+code module Event.pm that you can get from CPAN. The rest of Stem is
+comprised of pure Perl modules which need no special installation
+handling. Read the INSTALL document for more on how to
+install it. The quickstart instruction is simply to cd to the stem
+download directory and say
+./install.pl
+
+Much more on this can be found in the <A
+href="/tech_notes/design_notes.html">config_notes</A> document or in
+the Design directory of the tarball.
+
+Can Stem Do Guaranteed Messaging?
+
+*Stem's core design does not directly support guaranteed message
+delivery. It was designed this way, as the technical market that Stem
+targets does not have that strong a requirement for this feature as the
+commercial/e-business markets have. Future releases of Stem will support
+guaranteed delivery via a separate module that is now under development.
+
+Does Stem Use XML?
+
+Stem's messages are designed to not be specific to any format or
+encoding. They can carry data structure in any format the designer wants
+including XML. In fact, the message itself can also be in any format as
+long as it is properly identified and a module to decode that format is
+installed. Currently only the Stem internal message format is used but
+as demand arises, other message formats, including XML will be
+supported. One longer term goal is that message formats from many other
+systems will be supported by gateway modules which will translate
+between Stem and external messages.
+
+What Kind Of Security Does Stem Use?
+
+Stem doesn't directly do authentication and secure transmissions. Rather
+it relies upon industry standard utilities such as SSL, ssh and stunnel to
+provide secure socket connections between Stem hubs (processes).
+
+Can Stem Do Central Configuration Management?
+
+The log management project under development has this requirement. The
+lists of log files on each system that need to be monitored are
+maintained on the central system. Configuration files are auto-generated
+from those lists and distributed to all the Stem hubs in this network
+application. The same mechanism can be used to distribute configuration
+files for other applications and Stem can also notify them to reload the
+new files.
+
+Can Stem Handle My Content Distribution?
+
+Distributing content is similar to distributing configuration files and
+will use the same mechanisms. What content is distributed to where can
+all be easily controlled by Stem configurations without any additional
+programming.
+
+Can I Extend Stem Myself To Suit Our Needs?
+
+Stem is designed to be modified and extended very easily. You can copy
+existing modules or use design ideas from them to created new Cells for
+your own needs. The high level Cell API hides the complexities of
+network communication and message transfer, leaving you free to focus on
+the specific design and coding of your custom Cells.
+
+Should I Modify Stem On My Own Or Use Stem's Development Team?
+
+If your requirements are simple, and you have skilled staff to do the
+work, there's no reason not to develop and maintain your own Stem-based
+systems. If your applications are complex applications, your staff new
+to Stem, or your time-frame short, you will probably find it more
+cost-effective to let Stem Systems' expert team develop your system for
+you.
+
+Otherwise Stem Systems can assist you in the design, development and
+configuration of your application. How much assistance can be provided
+depends on the customer subscription deal and any other contracts. If
+you do not have a subscription, our support will be limited to bug fixes
+and email and you will have to maintain your modified code on your own.
+
+Which Operating Systems Support Stem?
+
+Stem runs without any modification under any Unix flavor (Solaris,
+Linux, FreeBSD, etc.) Support for WinX is in the planning stage and is
+expected to be released in Q3 2002.
+
+How Can I Contribute to Stem?
+
+What Does Stem's Open Source License Allow Me To do?
+
+Is Stem Open Source?
+
+We are happy to announce that as of version 0.06, Stem is now under
+the GPL.
+
+What Is Stem Systems?
+
+Stem Systems is the company which is developing and maintaining Stem. It
+owns the copyright to the Stem code base and is releasing it to its
+customers and the open source community. Stem Systems also sells support
+subscriptions to the Stem user community.
+
+What Is the Business Model Of Stem Systems?
+
+Stem itself is free to use. Users can buy support subscriptions from
+Stem Systems which include Stem configuration and development
+assistance. Subscribers get earlier access to releases of new Stem
+versions and modules and direct support from Stem's development team.
+
+How Much Does a Stem Subscription Cost?
+
+The base price is an annual fee of $300 for each computer system (box)
+which is running Stem. Volume, site and educational discounts are
+available.
+
+Who Are Your Technical Advisors?
+
+
+
+What Are Your Resources?
+
+How Can I Learn Stem?
+
+The best way right now is to start with the technical notes and get a
+basic understanding of Stem, its architecture and its nomenclature. Then
+run the various demo scripts and read their configuration files.
+Developers will go next to the Cell documentation which describes each
+Cell's function, their attributes and how to configure it. There are no
+training materials now, but we are discussing the creation of classes
+with a training firm for when the demand arises.
+
+What Is the Future Of Stem?
+
+Stem will constantly be growing it Cell library and adding support for
+new features. Whenever any repeated networked operation can be
+identified, Stem will create a Stem Cell to perform it. Then Stem's
+users can easily integrate that new Cell without programming or needing
+to reinvent that wheel.
+
+Who Created Stem?
+
+Stem was created by Uri Guttman, and is the culmination of his long
+career in systems architecture and development. He has combined a
+quarter century of experience designing and implementing event-driven
+systems with his love of Perl to produce a powerful, yet easy-to-use
+framework for network applications. For more on Stem's creator, see the
+Stem Team biographies.
+
+How (and why) was Stem conceived?
+
+Stem was created when its designer was contracted to a network
+application development group where they were constantly putting out
+fires and creating a massive ad hoc system. It was clear that they
+needed a framework to give structure to their network application
+design. Stem was the result.
+
+What Does Stem Stand For?
+
+Stem is not an acronym or an abbreviation, rather it is named from the
+real word 'stem' which has several dictionary meanings that map well to Stem.
+
+v. tr.
+ 1. To stop or hold back by or as if by damming; as in "stem the tide"
+
+n.
+ 1. A slender stalk supporting or connecting another plant part, such
+ as a leaf or flower.
+ 2. A connecting or supporting part.
+
+n.
+ 1. A line of ancestry : STOCK; especially : a fundamental line from
+ which others have arisen. as in "stem cell" in biology.
--- /dev/null
+ STEM CODE HISTORY 2001
+
+$Id: HISTORY-2001,v 1.1 2001/02/07 10:09:09 uri Exp $
+
+20010109:
+
+ mengwong@pobox.com created a repository of stem-0.04.
+
+20010110:
+ amused@pobox.com verified cvs operation
+ uri@stemsystems.com verified cvs operation
+ mengwong@pobox.com added loginfo mailing to devel@stemsystems.com
+
--- /dev/null
+S: About M<Stem>
+
+
+Q: What is M<Stem>?
+
+A: M<Stem> is a general purpose networking toolkit and a suite of ready
+to use network applications. Its goal is to transform common network
+programming to configuration and make uncommon network programming much
+simpler. Some M<Stem> users will use its suite of applications and
+modules and just configure them to perform their needed network
+tasks. Others will create new M<Stem> modules to perform their specific
+tasks and integrate them with M<Stem>'s standard modules using
+configurations. In both cases, M<Stem> will speed up network
+application development, simplify maintenance, and lower lifetime costs.
+
+
+Q: Where can I get M<Stem>?
+A: M<Stem> can now be downloaded by the general public. Go to the
+<A HREF="download.html">download</A> page to get the latest version.
+
+
+Q: What Can I Do With M<Stem>?
+A: M<Stem> is a general purpose networking toolkit. As such, it can
+be the backbone or framework of almost any networked (distributed)
+application you can imagine. M<Stem> is designed with standard modules
+that are aimed at specific application niches. Some M<Stem> users
+want a simple solution to common problems while others need a way to
+accelerate network application development. Via this modular design,
+M<Stem> can satisfy the differing needs of both groups.
+
+
+Q: What Are the Top M<Stem> Applications?
+A: The most commonly requested applications of
+M<Stem> are log management, file distribution,
+monitoring and remote command execution. For more on
+M<Stem> applications, see the <A href="products.html">niches</A> page.
+
+QUOTE<
+ Stem Monitoring. \
+ Overloaded Server Appears. \
+ Remediation. \
+ -- U.G. \
+ >
+
+Q: Why Should I Use M<Stem>?
+A: You should use M<Stem> if:
+<UL>
+ <LI><P>You are tired of reinventing the wheel for each
+ network application you build. M<Stem> provides you with all
+ the common services that a network application needs and
+ makes them very simple to use.</P></LI>
+
+ <LI><P>You don't want to be forced to rely on a commercial
+ monolithic network tool that everyone hates to use. M<Stem> is
+ low cost and Open Source. You can easily write new modules
+ to customize M<Stem> to your needs.</P></LI>
+
+ <LI><P>You want to dramatically reduce the development
+ and maintenance costs of developing your new
+ network applications. M<Stem> tranforms common network
+ programming to configuration. Even if you create new M<Stem>
+ modules, it is very simple to connect them together with
+ M<Stem> configurations. This lowers your development time and
+ costs in many ways.</P></LI>
+
+ <LI><P>You just want to use a well-designed network system that
+ will make your profession much more enjoyable. M<Stem> is
+ architected to be easy to use at both the configuration and
+ coding levels. Our goal is for all M<Stem> users to enjoy
+ working with it and reduce the frustrations and stress of
+ network management.</P></LI>
+</UL>
+
+<P>These are just a few of the many reasons why
+M<Stem> should be in place on your network.
+If you have questions on how M<Stem> will benefit
+your individual needs, <A HREF="mailto:faq@stemsystems.com">please contact us</A>.
+
+
+Q: Who Is Using M<Stem>?
+A: A start up firm hired M<Stem Systems> to implement a specialized
+web crawler. M<Stem> will be used as
+the communications backbone for this multiprocessor system and
+it will interconnect and manage all of its components. Some of
+those components include subprocesses doing the page fetches,
+site objects, html page parsers, custom filters, crawl management
+and a database.
+
+QUOTE<
+ Divers search limpid pools. \
+ Precious Perl is summer's find, \
+ But Stem is loved more. \
+ -- D.G. \
+>
+
+Q: How can I be notified about M<Stem> updates?
+A: M<Stem Systems> has a email list dedicated to M<Stem> updates. To
+subscribe, send an empty email to: news-subscribe@stemsystems.com. This
+is a low volume list used for sending important news regarding M<Stem>
+(ie - new releases).
+
+S: M<Stem> Design
+
+Q: Do I Need To Get Rid Of [Commercial Application] To Use M<Stem>?
+A: No, M<Stem> can run in parallel with all of
+your existing applications. As long as M<Stem>
+can have access to its own TCP ports (which can be configured to
+any available ones), it has no need to conflict with any of your current
+systems.
+
+QUOTE<
+ superglue the net \
+ tie the machines together \
+ stem keeps it all sane \
+ -- U.G. \
+>
+
+
+Q: What is a M<Stem> Hub?
+A: A M<Stem> Hub is a single Perl process running
+M<Stem>. It can function as a complete standalone
+application or be connected to other M<Stem> Hubs in a
+networked application. M<Stem> Hubs contain the
+M<Stem> core system and M<Stem>
+Cells that have been created by configuration files.
+
+<P>For more on this, read the
+<A href="technotes/arch_notes.html">architecture notes</A> document or find it
+in the Design directory of the tarball.
+
+Q: What is a M<Stem> Cell?
+A: A M<Stem> Cell is a Perl object that has 3 major characteristics:
+
+<OL>
+ <LI><P>First, it is registered as a Cell in this Hub with a cell name and
+ an optional target name</P></LI>
+ <LI><P>It has a set of methods designated to handle messages directed at
+ the Cell</P></LI>
+ <LI><P>It sends messages to other cells.</P></LI>
+</OL>
+
+
+S: M<Stem> Features
+
+
+Q: What is a M<Stem> Message?
+A: M<Stem> Messages carry commands and data between
+M<Stem> Cells. They are addressed with a
+Hub/Cell/Target triplet.
+
+<P>Messages can be any one of a wide range of types including command,
+data, log, stderr etc. They can carry any form of data to a maximum
+(to be designated later) size.
+
+<P>See
+<A HREF="technotes/message_notes.html">message notes</A> document for more.
+
+QUOTE<
+ Nets catch more than fish. \
+ Data's trapped beneath the waves. \
+ Stem frees; packets breathe. \
+ -- D.G. \
+>
+
+
+Q: How Hard Is M<Stem> To Install/Configure?
+A: M<Stem> is very easy to install. It only requires
+Perl 5.005_03 and one code module Event.pm that you can get from
+<A HREF="http://search.cpan.org">CPAN</A>. The rest of
+M<Stem> is comprised of pure Perl modules.
+
+<p>M<Stem> has a step by step installation
+script that guides you through the installation process and any
+required modules that are necessary for the normal functioning of M<Stem>.
+It is easy to use and allows you to customize the installation to
+your liking or take the default install.
+
+<P>Much more on this can be found in the
+<A href="technotes/config_notes.html">config notes</A>
+document or in the Design directory of the tarball.
+
+
+Q: Can M<Stem> Do Guaranteed Messaging?
+A: M<Stem>'s core design does not directly support
+guaranteed message delivery. It was designed this way, as the
+technical market that M<Stem> targets
+doesn't have a strong requirement for this feature as the
+commercial/e-business markets have.
+
+<P>Future releases of M<Stem> will support guaranteed delivery via a
+separate module that is now under development.
+
+
+
+Q: Does M<Stem> Use XML?
+A: M<Stem>'s messages are designed to not be specific
+to any format or encoding. They can carry data structure in any format the
+designer wants, including XML. In fact, the message itself can also be in
+any format as long as it is properly identified and a module to decode that
+format is installed.
+
+<p>M<Stem> is currently in the process of including
+<a href="http://www.yaml.org" name="YAML">YAML</a> as its primary format for
+messages, configuration files, and logs, but as demand arises other message formats
+including XML will be supported.
+
+<P>One longer-term goal is that message formats from many other
+systems will be supported by gateways modules, which will translate
+between M<Stem> and external messages.
+
+Q: What Kind Of Security Does M<Stem> Use?
+A: M<Stem> doesn't do direct authentication and secure
+transmissions. Currently it relies upon industry standard utilities such as ssh and
+stunnel to provide the secure socket connections between
+M<Stem> hubs (processes). Security is a great concern to
+everyone and M<Stem> development is looking into the possibilities
+of supporting various mechanisms and levels of security (i.e. - ssh, ssl, etc)
+through configurable modules.
+
+QUOTE<
+ Information rain \
+ Can drown the sleepy server, \
+ But for Stem's shelter. \
+ -- D.G. \
+>
+
+
+Q: Can M<Stem> Do Central Configuration Management?
+A: The log management project under development has this requirement. The
+lists of log files on each system that need to be monitored are
+maintained on the central system. Configuration files are autogenerated
+from those lists and distributed to all the M<Stem> hubs in this network
+application. The same mechanism can be used to distribute configuration
+files for other applications and M<Stem> can also notify them to reload the
+new files.
+
+Q: Can M<Stem> Handle My Content Distribution?
+A: Distributing content is similar to distributing configuration files and
+will use the same mechanisms. What content is distributed to where can
+all be easily controlled by M<Stem> configurations without any additional
+programming.
+
+
+S: Developing with M<Stem>
+
+
+Q: Can I Extend M<Stem> Myself To Suit Our Needs?
+A: M<Stem> is designed to be modified and extended very
+easily. You can copy existing modules or use design ideas from them to
+created new Cells for your own needs.
+
+<P>The high level Cell API hides the complexities of
+network communication and message transfer, leaving you free to focus on
+the specific design and coding of your custom Cells.
+
+
+QUOTE<
+ Just one message lost \
+ could stop your business blooming. \
+ Fear not: grasp the stem! \
+ -- D.G. \
+>
+
+Q: Is There a M<Stem> Tutorial?
+A: M<Stem> Development has created a <a href="cookbook.html" name="cookbook">cookbook</a> of examples that demonstrates the
+design of M<Stem> cells from the simplest form up
+to various levels of complexity.
+
+
+Q: Should I Modify M<Stem> On My Own Or Use M<Stem>'s Development Team?
+A: If your requirements are simple, and you have skilled staff to do the
+work, there's no reason not to develop and maintain your own M<Stem>-based
+systems. If your applications are complex applications, your staff new
+to M<Stem>, or your time-frame short, you will probably find it more
+cost-effective to let M<Stem Systems>' expert team develop your system for
+you.
+
+<P>Otherwise, M<Stem Systems> can assist you in the design, development and
+configuration of your application. How much assistance can be provided
+depends on the customer subscription deal and any other contracts. If
+you do not have a subscription, our support will be limited to bug fixes
+and email and you will have to maintain your modified code on your own.
+
+Q: Which Operating Systems Support M<Stem>?
+A: M<Stem> runs runs without any modification under any Unix flavor (Solaris,
+Linix, FreeBSD, etc.) Support for WinX is in the planning stage and is
+expected to be released in the near future.
+
+Q: What Is M<Stem>'s License?
+A: M<Stem> will be released under the <a
+href="http://www.gnu.org/copyleft/gpl.html" name="GPL">GNU General
+Public License</a> starting with version 0.06. Our intent is for
+M<Stem> to be free for non-commercial use. Commercial licenses can be
+purchased through M<Stem Systems>. Please contact <a
+href="mailto:info@stemsystems.com">Stem Systems</a> for more
+information regarding commercial license.
+
+
+S: M<Stem Systems>
+
+
+Q: What Is M<Stem Systems>?
+A: M<Stem Systems> is the company which is developing and maintaining M<Stem>. It
+owns the copyright to the M<Stem> codebase and is releasing it to its
+customers and the open source community. M<Stem Systems> also sells support
+subscriptions to the M<Stem> user community.
+
+QUOTE<
+ Black chips nurture life. \
+ Data shoots out, seeking Spring. \
+ Stem makes all fertile. \
+ -- D.G. \
+>
+
+Q: What Is The Business Model Of M<Stem Systems>?
+A: M<Stem Systems> has three business models,
+<ol>
+ <li>Development Projects</li>
+ <li>Support Subscriptions</li>
+ <li>3rd Party products and VAR's</li>
+</ol>
+
+Q: How Much Does M<Stem> Cost?
+A: 0.06 will be under the
+<a href="http://www.gnu.org/copyleft/gpl.html" name="GPL">GNU General
+Public License</a>. M<Stem> can be used freely for non-commercial
+use. For commercial and acedemic licenses please contact us at <a
+href="mailto:sales@stemsystems.com">Stem Systems</a> for more
+information.
+
+
+Q: Who Are Your Technical Advisors?
+A: Our technical advisors are listed <A HREF="company.html">here</A>.
+
+S: Miscellaneous
+
+
+Q: How Can I Learn M<Stem>?
+A: The best way right now is to start with the technical notes and get a
+basic understanding of M<Stem>, its architecture and
+its nomenclature. Then run the various demo scripts and read their
+configuration files. Developers will go next to the Cell documentation that
+describes each Cell's function, their attributes and how to configure it.
+Once some insight into each Cell is attained the next step would be to go
+through M<Stem>'s <a href="cookbook.html" name="cookbook">cookbook</a>
+of examples put together by the developers of M<Stem>. This will
+show you how to extend M<Stem> with your own Cells.
+
+<P>We are discussing the
+creation of classes with a training firm when the demand arises.
+
+Q: What Is The Future Of M<Stem>?
+A: M<Stem> will constantly be growing its Cell library and adding support for
+new features. Whenever any repeated networked operations can be
+identified, M<Stem> will create a M<Stem> Cell to
+perform it. Then M<Stem>'s
+users can easily integrate that new Cell without programming or needing
+to re-invent that wheel.
+
+Q: Who Created M<Stem>?
+A: M<Stem> was created by Uri Guttman, and is the
+culmination of his long career in systems architecture and development. He has combined a
+quarter century of experience designing and implementing event-driven
+systems with his love of Perl to produce a powerful, yet easy-to-use
+framework for network applications.
+
+<P>For more on M<Stem>'s creator, see the
+<A HREF="http://stemsystems.com/company.html">M<Stem> Team biographies</A>.
+
+Q: How (and why) Was M<Stem> Conceived?
+A: M<Stem> was created when its designer was contracted
+to a network application development group who were constantly
+putting out fires and creating a massive ad hoc system. It was clear that they needed a
+framework to give structure to their network application design.
+M<Stem> was the result.
+
+QUOTE<
+ Coders or firemen? \
+ System in conflagration. \
+ From ashes rose Stem. \
+ -- U.G. \
+>
+
+
+Q: What Does M<Stem> Stand For?
+A: M<Stem> is not an acronym or an abbreviation, rather it is named from the
+real word 'stem' which has several dictionary meanings that map well to M<Stem>.
+
+<DL><DT><B>v. tr.</B></DT>
+<DD><OL><LI>To stop or hold back by or as if by damming; as in "stem the tide"</OL></DD></DL>
+
+<DL><DT><B>n.</B></DT>
+<DD><OL><LI>A slender stalk supporting or connecting another plant part, such as a leaf or flower.
+ <LI>A connecting or supporting part.
+</OL></DD></DL>
+
+<DL><DT><B>n.</B></DT>
+<DD><OL><LI>A line of ancestry : STOCK; especially : a fundamental line from
+which others have arisen. as in "stem cell" in biology.</OL></DD></DL>
+
+
+QUOTE<
+ To keep your network \
+ flowering when the heat's on, \
+ it needs a strong stem. \
+ -- D.C. \
+>
--- /dev/null
+#!/usr/local/bin/perl -w
+
+use strict ;
+use Carp ;
+
+use YAML ;
+
+my @markup = (
+
+ {
+ 'search' => 'M<[^<>]+>',
+ 'replace' => sub {
+ my ( $text ) = @_;
+
+ $text =~ s|M<([^<>]+)>|<SPAN CLASS="stem">$1</SPAN>|sg;
+
+ $text;
+ },
+
+ },
+
+ {
+ 'search' => 'QUOTE<(.*?)>',
+ 'replace' => sub {
+ my ( $text ) = @_;
+
+ $text =~ /QUOTE<(.*?)>/gs;
+
+ my $before = $`;
+ my $after = $';
+ my $quote = $1;
+
+ $quote =~ s/\\/<BR>/sg;
+
+ $before .
+ "<P><TABLE BORDER='0' ALIGN='CENTER' CELLPADDING='3'" .
+ " CELLSPACING='0' BGCOLOR='FORESTGREEN'><TR><TD>" .
+ "<TABLE WIDTH='100%' CELLPADDING='3' CELLSPACING='2'" .
+ " BORDER='0' BGCOLOR='#CFE7CF'><TR><TH> $quote" .
+ "</TH></TR></TABLE></TD></TR></TABLE>" .
+ $after;
+ },
+ },
+
+ );
+
+
+my (
+ @sections,
+
+ $header_text,
+
+ $page_title_base
+);
+
+set_header_text() ;
+
+process_faq_text() ;
+
+process_sections() ;
+
+print_section_page() ;
+
+exit ;
+
+
+sub process_faq_text {
+
+ my ( $section, $quest_text, $answer_text, $curr_faq ) ;
+
+ while( <> ) {
+
+ next if /^\s*$/ ;
+ s/\n/ /;
+
+ if ( /^([SQ]):\s*(.+)$/ ) {
+
+
+ if ( $curr_faq ) {
+
+
+ $curr_faq->{'answer'} =
+ markup_text( $answer_text ) ;
+
+ $answer_text = '' ;
+
+ unless ( $curr_faq->{'question'} &&
+ $curr_faq->{'answer'} ) {
+
+
+ die
+
+ "bad FAQ entry before line $. in $ARGV\n" ;
+ }
+
+ push( @{$section->{'faqs'}}, $curr_faq ) ;
+ $curr_faq = undef ;
+ }
+
+ if ( $1 eq 'S' ) {
+
+ my $section_title = $2 ;
+
+ push( @sections, $section ) if $section ;
+
+ $section = {
+
+ 'plain_title' => $section_title,
+ 'title' => markup_text( $section_title ),
+ } ;
+
+ next ;
+ }
+
+ $quest_text = $2 ;
+
+ next ;
+ }
+
+ if ( /^A:\s*(.+)$/ ) {
+
+ $answer_text = markup_text( $1 ) ;
+
+ $curr_faq = {
+ 'question' => markup_text( $quest_text ),
+ } ;
+
+ $quest_text = '' ;
+ next ;
+ }
+
+ if ( $quest_text ) {
+
+ $quest_text .= $_ ;
+ next ;
+ }
+
+ $answer_text .= $_ ;
+ }
+
+ push( @sections, $section ) ;
+}
+
+
+sub process_sections {
+
+
+ my $sect_num = 1 ;
+
+ foreach my $sect_ref ( @sections ) {
+
+
+ my $title = $sect_ref->{'title'} ;
+
+ $sect_ref->{'num'} = $sect_num ;
+
+ my $link = <<LINK ;
+$sect_num <A HREF="faq$sect_num.html">$title</A>
+LINK
+
+ $sect_ref->{'link'} = $link ;
+
+ my $quest_num = 1 ;
+
+ foreach my $faq_ref ( @{$sect_ref->{'faqs'}} ) {
+
+ my $quest = $faq_ref->{'question'} ;
+
+ my $answer = $faq_ref->{'answer'} ;
+
+ $faq_ref->{'num'} = $quest_num ;
+ $faq_ref->{'index'} = "$sect_num.$quest_num" ;
+
+ $faq_ref->{'link'} = <<LINK ;
+$sect_num.$quest_num <A HREF="faq$sect_num.html#FAQ$quest_num">$quest</A>
+LINK
+
+ $quest_num++ ;
+ }
+
+ $sect_num++ ;
+ }
+}
+
+
+sub print_section_page {
+
+ my $page_text = <<HTML ;
+<%attr>
+ title => "$page_title_base"
+</%attr>
+
+<A HREF="index.html">Home</A> > <B>FAQ</B>
+
+<HR CLASS="sep">
+
+<H1>Frequently Asked Questions</H1>
+
+<UL STYLE="list-style-type:none">
+HTML
+
+ foreach my $sect_ref ( @sections ) {
+
+ my $link = $sect_ref->{'link'} ;
+
+ $page_text .= "<LI>$link" ;
+
+ print_faq_pages( $sect_ref ) ;
+ }
+
+ $page_text .= "</UL>";
+
+ write_file( 'faq.html', $page_text ) ;
+
+}
+
+sub print_faq_pages {
+
+ my ( $sect_ref ) = @_ ;
+
+ my $quest_list ;
+
+ my $faq_text ;
+
+ my $plain_title = $sect_ref->{'plain_title'} ;
+ my $title = $sect_ref->{'title'} ;
+ my $sect_num = $sect_ref->{'num'} ;
+
+ my $page_text = <<HTML ;
+<%attr>
+ title => "$page_title_base > $plain_title"
+</%attr>
+
+<A HREF="index.html">Home</A> > <A HREF="faq.html">FAQ</A> > <B>$title</B>
+
+<HR CLASS="sep">
+
+<H1><A NAME="top">$title</A></H1>
+
+<HR CLASS="sep">
+
+HTML
+
+
+ $quest_list .= <<HTML ;
+<UL STYLE="list-style-type:none">
+HTML
+
+ foreach my $faq_ref ( @{$sect_ref->{'faqs'}} ) {
+
+ my $quest = $faq_ref->{'question'} ;
+ my $answer = $faq_ref->{'answer'} ;
+
+ my $faq_num = $faq_ref->{'num'} ;
+ my $faq_ind = $faq_ref->{'index'} ;
+
+ $quest_list .= <<HTML ;
+<LI>$faq_ref->{'link'}
+HTML
+
+
+ $faq_text .= <<HTML ;
+
+<A NAME="FAQ$faq_num"></A>
+
+<H3>$quest</H3>
+ <BLOCKQUOTE>
+$answer
+ </BLOCKQUOTE>
+
+<DIV CLASS="toplink"><A HREF="#top">Top</A></DIV>
+
+<HR CLASS="sep">
+
+HTML
+
+ }
+
+ $quest_list .= "</UL>" ;
+
+
+ my $section_list = '<UL STYLE="list-style-type:none">' ;
+
+ foreach my $s_ref ( @sections ) {
+
+ $section_list .= <<HTML ;
+<LI>$s_ref->{'link'}
+HTML
+
+ if ( $s_ref == $sect_ref ) {
+
+ $section_list .= $quest_list ;
+ }
+
+ }
+
+ $section_list .= "</UL>" ;
+
+ $page_text .= $section_list ;
+
+ $page_text .= $faq_text ;
+
+ write_file( "faq$sect_num.html", $page_text ) ;
+}
+
+
+sub set_header_text {
+
+ $page_title_base = 'Stem Systems, Inc. > Stem > FAQ'
+}
+
+
+sub write_file {
+
+ my( $file_name ) = shift ;
+
+ local( *FH ) ;
+
+ open( FH, ">$file_name" ) || carp "can't create $file_name $!" ;
+
+ print FH @_ ;
+}
+
+
+
+sub markup_text {
+
+ my ( $text ) = @_;
+
+ map {
+
+ if ($text =~ /$_->{'search'}/s) {
+
+ $text = $_->{'replace'}->($text);
+ }
+
+ } @markup;
+
+ return $text;
+
+}
+
+
+__END__
+
+
--- /dev/null
+
+ Installation Of Stem
+
+Installing Stem is simple as you can use the classic module install
+commmands:
+
+` perl Makefile.PL
+ make
+ make test
+ make install
+
+The installation uses Module::Build so you have to have that. You can
+get it from CPAN. The Makefile actually just is a passthrough that calls
+the Build program and is there for compatibility. You can bypass make
+and use the Build commands directly:
+
+on UNIX flavors do this:
+
+ perl Build.PL
+ Build
+ Build test
+ Build install
+
+on Windows do this:
+
+ perl Build.PL
+ perl Build
+ perl Build test
+ perl Build install
+
+The perl Makefile.PL or perl Build.PL command will query you for a
+short series of answers. These include where is perl, where to store the
+Stem executable scripts, where to store the Stem configuration files,
+etc. Each question will be explained in detail and has a reasonable
+default value.
+
+Stem has a set of demonstration applications and you will be asked if
+you want to install them. The driver scripts use xterm to
+bring up multiple windows so you can interact with the
+demonstrations. The Build.PL script will find xterms on most UNIX
+flavors that have X on them. OSX doesn't come with X by default but you
+can install the X cdrom if you want.
+
+NOTE: The xterm program is NOT required to run the demostrations. You
+can run the scripts and the commands which create the xterms will be
+printed. If you don't have xterms, they will fail but you can copy the
+Stem command (the part after the -e) and run them in terminal windows
+that you bring up yourself. This works on windows and OSX which doesn't
+have X installed. Just run those Stem commands in the order they are
+printed and each one in its own terminal window.
+
+Another option for the demo scripts is called ssfe (split screen front
+end). It is a general purpose C (UNIX only) utility that runs any
+command and provides command line editing and history. It is a nice
+little utility and it make running the demos a bit nicer. It is bundled
+in a IRC application call sirc and if you ask for it to be installed,
+the whole sirc package (just ssfe and sirc) will be built and
+installed. This build/install will be run in its own xterm. When it is
+done installing, it will sleep for a while. You can kill the xterm
+window or ^C in it and the rest of the Stem installation will continue.
+
+The installation answers you give will be stored in the module
+Stem::InstallConfig for use by any Stem application. This module is used
+by Build.PL to override the default installation answers. So the next
+time you do perl Build.PL you will see the previous choices you made as
+the defaults. Doing Build realclean will remove this module and you will
+see the original default answers.
+
+If you know the default answers are fully acceptable, you can do this:
+
+ perl Build.PL use_defaults=1
+
+and all the defaults will be used and no questions will be asked.
--- /dev/null
+###############################################################################
+ Copyright and Licensing Information for Stem
+
+The copyright and license on the Stem software system is as follows:
+
+ Copyright (C) 1999-2004 Stem Systems, Inc.
+
+ Stem is free software; you can redistribute it and/or modify it under
+ the terms of the GNU General Public License as published by the Free
+ Software Foundation; either version 2 of the License, or (at your
+ option) any later version.
+
+ Stem is distributed in the hope that it will be useful, but WITHOUT ANY
+ WARRANTY; without even the implied warranty of MERCHANTABILITY or
+ FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+ for more details.
+
+ You should have received a copy of the GNU General Public License along
+ with Stem in the file "COPYING" in this directory. If not, write to
+ the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
+ MA 02111-1307 USA
+
+
+ Stem Systems, Inc. provides other licensing options for Stem as part of
+ our business. For a license to use the Stem under conditions other
+ than those described here, to purchase support for this software, or to
+ purchase a commercial warranty contract, please contact Stem Systems
+ at:
+
+ Stem Systems, Inc. 781-643-7504
+ 79 Everett St. info@stemsystems.com
+ Arlington, MA 02474
+ USA
+###############################################################################
--- /dev/null
+Makefile.PL
+Build.PL
+BuildStem.pm
+META.yml
+MANIFEST
+CHANGELOG
+COPYING
+CREDITS
+README
+INSTALL
+LICENSE
+TODO
+DEMO
+DEMO_CHAT
+DEMO_INETD
+DEMO_TAIL
+Cookbook/cookbook.txt
+Cookbook/World1.pm
+Cookbook/World2.pm
+Cookbook/World3.pm
+Cookbook/World4.pm
+Cookbook/World5.pm
+Cookbook/worlds.stem
+Design/asyncio_notes
+Design/Stem-Mon
+Design/arch_notes
+Design/config_notes
+Design/cell_notes
+Design/console_notes
+Design/cron_notes
+Design/debug_notes
+Design/env_notes
+Design/event_notes
+Design/id_notes
+Design/index
+Design/log_notes
+Design/logtail_notes
+Design/message_notes
+Design/portal_notes
+Design/proc_notes
+Design/registry_notes
+Design/security_notes
+Design/sock_msg_notes
+Design/socket_notes
+Design/switch_notes
+Doc/FAQ.txt
+Doc/HISTORY-2001
+FAQ/faq_maker.pl
+FAQ/faq.text
+bin/run_stem
+bin/boot_stem
+bin/stem_msg
+bin/stem2pod
+bin/cgi2stem.pl
+bin/hello_demo
+bin/chat_demo
+bin/chat2_demo
+bin/inetd_demo
+bin/tail_demo
+bin/quote_serve
+bin/cli
+conf/chat_client.stem
+conf/archive.stem
+conf/boot.stem
+conf/chat.stem
+conf/chat_label.stem
+conf/chat_server.stem
+conf/cron.stem
+conf/cli.stem
+conf/hello.stem
+conf/hello_client.stem
+conf/hello_server.stem
+conf/hello_shell.stem
+conf/hello_yaml.stem
+conf/inetd.stem
+conf/load_driver.stem
+conf/load_echo.stem
+conf/monitor.stem
+conf/proc.stem
+conf/slave.stem
+conf/tail.stem
+conf/test_udp.stem
+conf/test_flow.stem
+conf/test_packet_io.stem
+conf/ticker.stem
+conf/ttysock.stem
+conf/type.stem
+extras/sirc-2.211.tar.gz
+lib/Stem.pm
+lib/Stem/Event.pm
+lib/Stem/Event/EventPM.pm
+lib/Stem/Event/Perl.pm
+lib/Stem/Event/Signal.pm
+lib/Stem/Event/Queue.pm
+lib/Stem/Event/Tk.pm
+lib/Stem/Event/Wx.pm
+lib/Stem/Msg.pm
+lib/Stem/Route.pm
+lib/Stem/Class.pm
+lib/Stem/Conf.pm
+lib/Stem/Boot.pm
+lib/Stem/Portal.pm
+lib/Stem/Hub.pm
+lib/Stem/Vars.pm
+lib/Stem/Cell.pm
+lib/Stem/Cell/Sequence.pm
+lib/Stem/Cell/Clone.pm
+lib/Stem/Cell/Flow.pm
+lib/Stem/Cell/Pipe.pm
+lib/Stem/Cell/Work.pm
+lib/Stem/Log.pm
+lib/Stem/Log/Entry.pm
+lib/Stem/Log/File.pm
+lib/Stem/Log/Tail.pm
+lib/Stem/Socket.pm
+lib/Stem/SockMsg.pm
+lib/Stem/UDPMsg.pm
+lib/Stem/Proc.pm
+lib/Stem/Switch.pm
+lib/Stem/Debug.pm
+lib/Stem/Trace.pm
+lib/Stem/Inject.pm
+lib/Stem/Cron.pm
+lib/Stem/DBI.pm
+lib/Stem/File.pm
+lib/Stem/Console.pm
+lib/Stem/Id.pm
+lib/Stem/Gather.pm
+lib/Stem/Util.pm
+lib/Stem/AsyncIO.pm
+lib/Stem/WorkQueue.pm
+lib/Stem/ChatLabel.pm
+lib/Stem/TtySock.pm
+lib/Stem/Packet.pm
+lib/Stem/Codec.pm
+lib/Stem/Codec/Data/Dumper.pm
+lib/Stem/Codec/Storable.pm
+lib/Stem/Codec/YAML.pm
+lib/Stem/Load/Driver.pm
+lib/Stem/Load/Ticker.pm
+lib/Stem/Test/ConfTypes.pm
+lib/Stem/Test/Echo.pm
+lib/Stem/Test/Flow.pm
+lib/Stem/Test/PacketIO.pm
+lib/Stem/Test/UDP.pm
+lib/Stem/Demo/World.pm
+lib/Stem/Demo/CLI.pm
+t/event/event_test.pl
+t/event/perl.t
+t/event/event.t
+t/event/poe.t
+t/event/tk.t
+t/event/wx.t
+t/event/gtk.t
+t/event/qt.t
+t/socket/plain.t
+t/socket/plain_fork.t
+t/socket/ssl_fork.t
+t/socket/udp.t
+t/socket/SockFork.pm
+t/cell/flow.t
+t/io/packet.t
+sessions/client.pl
+sessions/mid_event.pl
+sessions/mid_event_async.pl
+sessions/backend.pl
+certs/client-cert.pem
+certs/client-key.enc
+certs/client-key.pem
+certs/my-ca.pem
+certs/server-cert.pem
+certs/server-key.enc
+certs/server-key.pem
+certs/test-ca.pem
--- /dev/null
+--- #YAML:1.0
+name: Stem
+version: 0.11
+author: ~
+abstract: ~
+license: gpl
+dynamic_config: 1
+provides:
+ Stem:
+ file: lib/Stem.pm
+ version: 0.11
+ Stem::AsyncIO:
+ file: lib/Stem/AsyncIO.pm
+ Stem::Boot:
+ file: lib/Stem/Boot.pm
+ Stem::Cell:
+ file: lib/Stem/Cell/Sequence.pm
+ Stem::ChatLabel:
+ file: lib/Stem/ChatLabel.pm
+ Stem::Class:
+ file: lib/Stem/Class.pm
+ Stem::Codec:
+ file: lib/Stem/Codec.pm
+ Stem::Codec::Data::Dumper:
+ file: lib/Stem/Codec/Data/Dumper.pm
+ Stem::Codec::Storable:
+ file: lib/Stem/Codec/Storable.pm
+ Stem::Codec::YAML:
+ file: lib/Stem/Codec/YAML.pm
+ Stem::Conf:
+ file: lib/Stem/Conf.pm
+ Stem::Console:
+ file: lib/Stem/Console.pm
+ Stem::Cron:
+ file: lib/Stem/Cron.pm
+ Stem::DBI:
+ file: lib/Stem/DBI.pm
+ Stem::Debug:
+ file: lib/Stem/Debug.pm
+ Stem::Demo::CLI:
+ file: lib/Stem/Demo/CLI.pm
+ Stem::Demo::World:
+ file: lib/Stem/Demo/World.pm
+ Stem::Event:
+ file: lib/Stem/Event.pm
+ Stem::Event::EventPM:
+ file: lib/Stem/Event/EventPM.pm
+ Stem::Event::IO:
+ file: lib/Stem/Event.pm
+ Stem::Event::Perl:
+ file: lib/Stem/Event/Perl.pm
+ Stem::Event::Plain:
+ file: lib/Stem/Event/Perl.pm
+ Stem::Event::Queue:
+ file: lib/Stem/Event/Queue.pm
+ Stem::Event::Read:
+ file: lib/Stem/Event.pm
+ Stem::Event::Signal:
+ file: lib/Stem/Event/Signal.pm
+ Stem::Event::Timer:
+ file: lib/Stem/Event.pm
+ Stem::Event::Tk:
+ file: lib/Stem/Event/Tk.pm
+ Stem::Event::Write:
+ file: lib/Stem/Event.pm
+ Stem::Event::Wx:
+ file: lib/Stem/Event/Wx.pm
+ Stem::Event::Wx::App:
+ file: lib/Stem/Event/Wx.pm
+ Stem::Event::Wx::Timer:
+ file: lib/Stem/Event/Wx.pm
+ Stem::File:
+ file: lib/Stem/File.pm
+ Stem::Gather:
+ file: lib/Stem/Gather.pm
+ Stem::Hub:
+ file: lib/Stem/Hub.pm
+ Stem::Id:
+ file: lib/Stem/Id.pm
+ Stem::Inject:
+ file: lib/Stem/Inject.pm
+ Stem::Load::Driver:
+ file: lib/Stem/Load/Driver.pm
+ Stem::Load::Ticker:
+ file: lib/Stem/Load/Ticker.pm
+ Stem::Log:
+ file: lib/Stem/Log.pm
+ Stem::Log::Entry:
+ file: lib/Stem/Log/Entry.pm
+ Stem::Log::File:
+ file: lib/Stem/Log/File.pm
+ Stem::Log::Tail:
+ file: lib/Stem/Log/Tail.pm
+ Stem::Msg:
+ file: lib/Stem/Msg.pm
+ Stem::Packet:
+ file: lib/Stem/Packet.pm
+ Stem::Portal:
+ file: lib/Stem/Portal.pm
+ Stem::Proc:
+ file: lib/Stem/Proc.pm
+ Stem::Route:
+ file: lib/Stem/Route.pm
+ Stem::SockMsg:
+ file: lib/Stem/SockMsg.pm
+ Stem::Socket:
+ file: lib/Stem/Socket.pm
+ Stem::Switch:
+ file: lib/Stem/Switch.pm
+ Stem::Test::ConfTypes:
+ file: lib/Stem/Test/ConfTypes.pm
+ Stem::Test::Echo:
+ file: lib/Stem/Test/Echo.pm
+ Stem::Test::Flow:
+ file: lib/Stem/Test/Flow.pm
+ Stem::Test::PacketIO:
+ file: lib/Stem/Test/PacketIO.pm
+ Stem::Test::UDP:
+ file: lib/Stem/Test/UDP.pm
+ Stem::Trace:
+ file: lib/Stem/Trace.pm
+ Stem::TtySock:
+ file: lib/Stem/TtySock.pm
+ Stem::UDPMsg:
+ file: lib/Stem/UDPMsg.pm
+ Stem::Util:
+ file: lib/Stem/Util.pm
+ Stem::Vars:
+ file: lib/Stem/Vars.pm
+ Stem::WorkQueue:
+ file: lib/Stem/WorkQueue.pm
+generated_by: Module::Build version 0.2611
--- /dev/null
+# Note: this file was auto-generated by Module::Build::Compat version 0.03
+
+ unless (eval "use Module::Build::Compat 0.02; 1" ) {
+ print "This module requires Module::Build to install itself.\n";
+
+ require ExtUtils::MakeMaker;
+ my $yn = ExtUtils::MakeMaker::prompt
+ (' Install Module::Build now from CPAN?', 'y');
+
+ unless ($yn =~ /^y/i) {
+ die " *** Cannot install without Module::Build. Exiting ...\n";
+ }
+
+ require Cwd;
+ require File::Spec;
+ require CPAN;
+
+ # Save this 'cause CPAN will chdir all over the place.
+ my $cwd = Cwd::cwd();
+ my $makefile = File::Spec->rel2abs($0);
+
+ CPAN::Shell->install('Module::Build::Compat')
+ or die " *** Cannot install without Module::Build. Exiting ...\n";
+
+ chdir $cwd or die "Cannot chdir() back to $cwd: $!";
+ }
+ eval "use Module::Build::Compat 0.02; 1" or die $@;
+ use lib '_build/lib';
+ Module::Build::Compat->run_build_pl(args => \@ARGV);
+ require BuildStem;
+ Module::Build::Compat->write_makefile(build_class => 'BuildStem');
--- /dev/null
+This is the README file for the Stem system. Stem is released under
+the GNU General Public License (http://www.gnu.org/copyleft/gpl.html).
+For more information regarding commercial licenses please visit the
+Stem Systems website at http://www.stemsystems.com.
+
+The information below assumes the Stem tarball unpacks into a dir with
+the name stem-0.NN (where NN is the version number). That directory path
+will be referred to as $STEM.
+
+You can find more text (FAQ, products) on the Stem web site:
+http://www.stemsystems.com. The technical notes are also on the web site
+but may be more up to date in the tarball.
+
+
+Stem Installation.
+
+The INSTALL file has complete instructions on how to install Stem on
+your system.
+
+Stem Demonstrations
+
+There are 4 Stem demonstration scripts. Read the DEMO file first to
+learn about their common features and then read the individual DEMO_*
+files for each one.
+
+Manifest
+
+README (this file) is in:
+
+ $STEM/README
+
+Stem installation instructions are in:
+
+ $STEM/INSTALL
+
+Stem demonstration script instructions are in:
+
+ $STEM/DEMO
+ $STEM/DEMO_CHAT
+ $STEM/DEMO_INETD
+ $STEM/DEMO_TAIL
+
+Event.pm is in the tarball (You can also it from CPAN):
+
+ $STEM/modules/Event-0.77.tar.gz
+
+Stem modules are in:
+
+ $STEM/lib/Stem.pm
+ $STEM/lib/Stem/
+
+Stem Example Configuration files are in:
+
+ $STEM/conf/
+
+Stem Executable scripts are in:
+
+ $STEM/bin/
+
+Technical Design Notes are in:
+
+ $STEM/Design/
+
+Documentation is in:
+
+ $STEM/Docs/
+
+ The latest FAQ is on the web site (http://www.stemsystems.com)
+
+Stem Cookbook is in:
+
+ $STEM/Cookbook/
+
+ssfe (split screen front end) is found in the sirc tarball:
+
+ $STEM/extras/sirc-2.211.tar.gz
+
+Test scripts are in:
+
+ $STEM/t/
+
+Utility scripts are in:
+
+ $STEM/utils/
--- /dev/null
+ Stem Development TODO List
+
+Feel free to tackle any of these tasks. Email uri@stemsystems.com if you
+want design/code ideas or to discuss any of these projects.
+
+Last edited Fri Jan 16 17:07:14 EST 2004
+
+Stem::Event::*
+
+ Add support for more event loops (Tk, Qt, tcl, WxWindows,
+ POE). See Stem::Event::EventPM for an example of how to wrap an
+ event loop in Stem.
+
+Stem::Msg, Stem::Route
+
+ enable tracing of delivered messages
+
+ basic source routing needs design work. new client hubs will
+ flood upstream who they are. master servers can respond
+ downstream which will create a fully aware tree networks.
+
+ add support for a forward. it takes a message, clones it and
+ changes the to address.
+
+ maybe move Stem::Route to Stem::Msg::Route. it is only used by
+ Stem::Msg and that better describes its name.
+
+Stem::Portal
+
+ finish and test Portal forking
+
+ maybe convert to use Class clone/piped support. not sure if this
+ is reasonable or worth it.
+
+Stem::Log
+
+ add support for single method ref to do all the filtering. it is
+ passed the log entry and is a stem::log::entry object. it can
+ call all the action methods. there is no need for the current
+ design of a list of key/values. it will be deprecated.
+
+ timestamp is set with a template (strftime like but numbers only).
+
+ add timer based filters. single shot cron entries to toggle
+ state are fine. but how do you set the state at startup? if it
+ is between start and end times, the filter should be
+ enabled. this needs design work.
+
+ define and add more actions
+
+ email
+ msg
+
+run_stem
+
+ write up run_stem man page in pod
+
+ write tech notes for run_stem
+
+Stem::Proc
+
+ needs much more testing
+
+ test pseudo tty
+
+Stem::File
+
+ (some of this is done. a good simple project to pick up)
+
+ design parent cell and how it spawns targeted file cells.
+
+ code file stem based transfer stuff.
+
+ add file compare options - size, timestamp, MD5
+
+ add single directory support.
+ filename filters
+
+ add dir tree copy support
+
+ add throttle support? don't want to slurp entire large file in
+ and clog the system. throttle with reply messages and/or timing
+
+ add support for ftp and scp
+
+Stem::Util
+
+ replace read_file/write_file with File::Slurp. might as well eat
+ my own dog food. this needs to be added to the required modules
+ list in Build.PL
+
+Stem::Expect
+
+ use proc or socket and use async IO
+
+ hook in Stem::Cell::Flow
+
+ expect handles timeouts from async IO. then it drives the state
+ machine with a timeout method. regular input is sent to the
+ state machine as data.
+
+ if no input matches but not timed out yet, we wait for more
+ input or the timeout.
+
+ do we need code callbacks? i think the higher level object
+ (protocol::ftp?) would want callbacks itself in some cases.
+
+Testing
+ need tests for higher level cells.
+
+ need load testing of various subsystems.
+
+ need cross platform testing.
+
+Documentation
+
+ full pods for all modules
+
+ accurate docs for all class fields. this can be autogenerated
+ from the $field_info lists. we could parse only that code out
+ easily and eval the string. the either edit the internal pod or
+ some other text file. it would generate a nicely formatted
+ description of all the class fields.
+
+Tracing
+
+ mark by name which message is currently being delivered
+
+ use the hub/cell/target in the 'to' address.
+
+ any newly dispatched messages get a from/origin of that to
+
+ just copy the to?
+
+ fix registry lookup by object to get cell/name and target
+
+ save current event cell name and target
+
+ create trace file to be written by events and message delivery
+ (or dispatch?)
--- /dev/null
+#!/usr/local/bin/perl -w
+
+use strict ;
+
+use Getopt::Std ;
+
+use YAML ;
+
+my %opts ;
+
+getopts( 'v', \%opts ) ;
+
+my $cmds = Load do{ local $/ ; <> } ;
+
+foreach my $boot ( @{$cmds} ) {
+
+ if ( my $skip = $boot->{'skip'} ) {
+
+ next if $skip eq 'yes' ;
+ }
+ my $wrap = $boot->{'wrap'} || '/bin/sh -c' ;
+ my $cd = $boot->{'cd'} || '.' ;
+ my $cmd = $boot->{'cmd'} ;
+
+ my $user = $boot->{'user'} || '';
+
+ my $env = $boot->{'env'} || {} ;
+ my $stem_env = $boot->{'stem_env'} || {} ;
+
+ local( %ENV ) = ( %ENV, %{$env} ) ;
+
+ my $cmd_env = join ' ', map( "$_='$stem_env->{$_}'", keys %$stem_env ) ;
+
+ $cmd =~ s/run_stem/run_stem $cmd_env/ ;
+
+ my $system;
+ $system = "su - $user;" if $user && getpwuid($<) ne $user;
+ $system .= qq|$wrap "cd $cd ; $cmd" &| ;
+
+ print "$system\n" if $opts{'v'} ;
+
+ system $system ;
+
+ my $delay = $boot->{'delay'} || 3 ;
+
+ print "waiting $delay seconds\n" if $opts{'v'};
+
+ sleep $delay ;
+}
--- /dev/null
+#!/usr/local/bin/perl -wT
+
+# This is a CGI script that interfaces to stem. it collects all the
+# CGI data and sends it to a Stem::SockMsg cell as a single
+# Stem::Packet. It reads a single Stem::Packet back from the socket
+# and uses the data in there to generate a response page.
+
+$|++ ;
+
+use strict ;
+use lib '/wrk/stem/src/stem/lib/' ;
+
+use CGI ;
+use CGI::Carp qw(fatalsToBrowser) ;
+use IO::Socket ;
+
+use Stem::Packet ;
+
+my $cgi = CGI->new() ;
+
+my %cgi_data ;
+
+# get all the cgi data we can
+
+$cgi_data{ 'params' } = get_cgi_data( 'param' ) ;
+$cgi_data{ 'cookies' } = get_cgi_data( 'cookie' ) ;
+#$cgi_data{ 'env' } = { %ENV } ;
+#$cgi_data{ 'self_url' } = $cgi->self_url() ;
+$cgi_data{ 'url' } = $cgi->url() ;
+#$cgi_data{ 'cgi' } = $cgi ;
+
+# todo: handle default host:port here
+
+my $data = send_and_get_packet( \%cgi_data ) ;
+
+# use Data::Dumper ;
+
+# print $cgi->header() ;
+# # print "<PRE>\n", Dumper( \%cgi_data ), "\n</PRE>\n" ;
+# print "<PRE>\n", Dumper( $data ), "\n</PRE>\n" ;
+
+# exit ;
+
+if ( ref $data eq 'SCALAR' ) {
+
+ print $$data ;
+ exit ;
+}
+
+print $cgi->header(), <<HTML ;
+<HTML>
+cgi2stem error: $data
+</HTML>
+HTML
+
+
+
+# this works for both cookies and params as their APIs are the same
+
+sub get_cgi_data {
+
+ my( $type ) = @_ ;
+
+ my %cgi_info ;
+
+ foreach my $name ( $cgi->$type() ) { ;
+
+ my @values = $cgi->$type( $name ) ;
+
+ if ( @values > 1 ) {
+ $cgi_info{ $type } = \@values ;
+ next ;
+ }
+
+ $cgi_info{ $name } = shift @values ;
+ }
+
+ return \%cgi_info ;
+}
+
+sub send_and_get_packet {
+
+ my( $in_data, $host, $port ) = @_ ;
+
+ $port ||= 9999 ;
+ $host ||= 'localhost' ;
+
+ my $sock = IO::Socket::INET->new( "$host:$port" ) ;
+
+ $sock or return "can't connect to $host:$port\n" ;
+
+ my $packet = Stem::Packet->new( codec => 'Storable' ) ;
+
+ my $write_buf = $packet->to_packet($in_data) ;
+
+ syswrite( $sock, $$write_buf ) ;
+
+ my $read_buf ;
+
+ while( 1 ) {
+
+ my $bytes_read = sysread( $sock, $read_buf, 8192 ) ;
+
+ return "sysread error $!" unless defined $bytes_read ;
+ return "sysread closed" if $bytes_read == 0 ;
+
+ my $result = $packet->to_data( $read_buf ) ;
+
+ return $result if $result ;
+ }
+}
--- /dev/null
+#!/usr/local/bin/perl -s
+
+$line_cnt = 10 ;
+$offset = 175 ;
+$base_off = 0 ;
+$xskip = ( $^O eq 'solaris' ) ? 600 : 500 ;
+
+my @children ;
+
+$SIG{ 'INT' } = \&cleanup ;
+
+if ( $s ) {
+
+ $ssfe = 'ssfe' ;
+ $prompt = '-prompt Stem:' ;
+ $prompt2 = '-prompt Chat:' ;
+ $echo = 'console_echo=1'
+}
+
+foreach $cmd ( split /\n/, <<EOT ) {
+xterm -T Chat1 -n Chat1 -geometry 80x25+XSKIP+0 -e $ssfe $prompt run_stem $echo chat_server
+xterm -T Chat2 -n Chat2 -geometry 80x25+XSKIP+250 -e $ssfe $prompt run_stem $echo chat_client
+xterm -T A -n A -geometry 80xLINE+0+OFF -e $ssfe $prompt2 telnet localhost 6666
+xterm -T B -n B -geometry 80xLINE+0+OFF -e $ssfe $prompt2 telnet localhost 6667
+xterm -T C -n C -geometry 80xLINE+0+OFF -e $ssfe $prompt2 telnet localhost 6668
+xterm -T D -n D -geometry 80xLINE+0+OFF -e $ssfe $prompt2 telnet localhost 6669
+EOT
+
+ $cmd =~ s/XSKIP/$xskip/ ;
+
+ $cmd =~ s/LINE/$line_cnt/ ;
+ $cmd =~ s/OFF/$base_off/ and $base_off += $offset ;
+
+print "$cmd\n" ;
+
+ @cmd = split ' ', $cmd ;
+
+ s/:/: / for @cmd ;
+
+ fork_exec( @cmd ) ;
+ sleep 2 unless $cmd =~ /localhost/ ;
+}
+
+while( <STDIN> ) {
+
+ next unless /^q/i ;
+
+ cleanup() ;
+}
+
+sub cleanup {
+
+ print "clean up\n" ;
+
+ kill 9, @children ;
+ wait ;
+ exit ;
+
+}
+
+sub fork_exec {
+
+ my( @exec ) = @_ ;
+
+ if ( $pid = fork() ) {
+
+ push @children, $pid ;
+ return ;
+ }
+
+ exec @exec ;
+}
--- /dev/null
+#!/usr/local/bin/perl -s
+
+$line_cnt = 10 ;
+$offset = 175 ;
+$base_off = 0 ;
+$xskip = ( $^O eq 'solaris' ) ? 600 : 500 ;
+
+print "CHAT DEMO\n" ;
+
+my @children ;
+
+$SIG{ 'INT' } = \&cleanup ;
+
+if ( $s ) {
+
+ $ssfe = 'ssfe' ;
+ $prompt = '-prompt Stem:' ;
+ $prompt2 = '-prompt Chat:' ;
+ $echo = 'console_echo=1'
+}
+
+foreach $cmd ( split /\n/, <<EOT ) {
+xterm -T Chat -n Chat -geometry 80x40+XSKIP+0 -e $ssfe $prompt run_stem $echo chat
+xterm -T A -n A -geometry 80xLINE+0+OFF -e $ssfe $prompt2 telnet localhost 6666
+xterm -T B -n B -geometry 80xLINE+0+OFF -e $ssfe $prompt2 telnet localhost 6667
+xterm -T C -n C -geometry 80xLINE+0+OFF -e $ssfe $prompt2 telnet localhost 6668
+xterm -T D -n D -geometry 80xLINE+0+OFF -e $ssfe $prompt2 telnet localhost 6669
+EOT
+
+ $cmd =~ s/XSKIP/$xskip/ ;
+
+ $cmd =~ s/LINE/$line_cnt/ ;
+ $cmd =~ s/OFF/$base_off/ and $base_off += $offset ;
+
+print "$cmd\n" ;
+
+ @cmd = split ' ', $cmd ;
+
+ s/:/: / for @cmd ;
+
+ fork_exec( @cmd ) ;
+ sleep 4 unless $cmd =~ /localhost/ ;
+}
+
+
+while( <STDIN> ) {
+
+ next unless /^q/i ;
+
+ cleanup() ;
+}
+
+sub cleanup {
+
+ print "clean up\n" ;
+
+ kill 9, @children ;
+
+ wait ;
+ exit ;
+
+}
+
+sub fork_exec {
+
+ my( @exec ) = @_ ;
+
+ if ( $pid = fork() ) {
+
+ push @children, $pid ;
+ return ;
+ }
+
+ exec @exec ;
+}
--- /dev/null
+#!/usr/local/bin/perl -w
+
+use strict ;
+
+use IO::Socket ;
+use Data::Dumper ;
+
+use Stem::Packet ;
+
+$| = 1 ;
+
+my $host = 'localhost' ;
+
+my $port = shift || 8888 ;
+
+my $sock = IO::Socket::INET->new( "$host:$port" ) ;
+$sock or die "can't connect to $host:$port\n" ;
+
+#my $packet = Stem::Packet->new( codec => 'YAML' ) ;
+my $packet = Stem::Packet->new() ;
+
+print "type 'help' for help\n\n" ;
+
+while( 1 ) {
+
+ print "CLI > " ;
+
+ chomp( my $line = <> ) ;
+ next unless $line =~ /\S/ ;
+
+#my $line = "foo bar bazz" ;
+
+ my %data ;
+ @data{ qw( op key value ) } = split( ' ', $line, 3 ) ;
+
+ my $write_buf = $packet->to_packet( \%data) ;
+#print "WRITE [$$write_buf]\n" ;
+
+ syswrite( $sock, "${$write_buf}" ) ;
+
+# this should be a proper non-blocking read loop but it is fine for this
+# demo.
+
+ my $bytes_read = sysread( $sock, my $read_buf, 8192 ) ;
+ last unless defined $bytes_read and $bytes_read > 0 ;
+
+ my $result = $packet->to_data( \$read_buf ) ;
+
+# print "RESULT [$$result]\n" ;
+ print Dumper $result ;
+
+#exit ;
+}
--- /dev/null
+#!/usr/local/bin/perl -s
+
+use strict ;
+use warnings ;
+our $s ;
+
+if ( -d 'conf' && -e 'bin/run_stem' ) {
+
+ $ENV{PERL5LIB} = 'lib' ;
+ $ENV{PATH} = "bin:$ENV{PATH}" ;
+}
+
+print "HELLO DEMO\n" ;
+
+$SIG{ 'INT' } = \&cleanup ;
+
+my @children ;
+
+my $ssfe = $s ? 'ssfe -prompt Stem:' : '' ;
+my $echo = $s ? 'console_echo=1' : '' ;
+
+my $cmd = <<CMD ;
+xterm -T Hello -n Hello -geometry 80x40+0+0 -e $ssfe run_stem $echo hello
+CMD
+
+print "$cmd\n" ;
+
+my @cmd = split ' ', $cmd ;
+s/:/: / for @cmd ;
+
+fork_exec( @cmd ) ;
+
+while( <STDIN> ) {
+
+ next unless /^q/i ;
+
+ cleanup() ;
+}
+
+sub cleanup {
+
+ print "clean up\n" ;
+
+ kill 9, @children ;
+
+ wait ;
+ exit ;
+
+}
+
+sub fork_exec {
+
+ my( @exec ) = @_ ;
+
+ if ( my $pid = fork() ) {
+
+ push @children, $pid ;
+ return ;
+ }
+
+ exec @exec ;
+}
--- /dev/null
+#!/usr/local/bin/perl -s
+
+$line_cnt = 10 ;
+$offset = 175 ;
+$base_off = 0 ;
+$xskip = ( $^O eq 'solaris' ) ? 600 : 500 ;
+
+my @children ;
+
+print "INETD: $ENV{PATH}\n" ;
+
+$SIG{ 'INT' } = \&cleanup ;
+
+if ( $s ) {
+
+ $ssfe = 'ssfe' ;
+ $prompt = '-prompt Stem:' ;
+ $echo = 'console_echo=1'
+# $prompt2 = '-prompt Chat:' ;
+}
+
+foreach $cmd ( split /\n/, <<EOT ) {
+xterm -T Stem -n Stem -geometry 80x40+XSKIP+0 -e $ssfe $prompt run_stem $echo inetd
+xterm -T A -n A -geometry 80xLINE+0+OFF -e $ssfe $prompt2 telnet localhost 6666
+xterm -T B -n B -geometry 80xLINE+0+OFF -e $ssfe $prompt2 telnet localhost 6667
+xterm -T C -n C -geometry 80xLINE+0+OFF -e $ssfe $prompt2 telnet localhost 6666
+xterm -T D -n D -geometry 80xLINE+0+OFF -e $ssfe $prompt2 telnet localhost 6667
+EOT
+
+ $cmd =~ s/XSKIP/$xskip/ ;
+
+ $cmd =~ s/LINE/$line_cnt/ ;
+ $cmd =~ s/OFF/$base_off/ and $base_off += $offset ;
+
+print "CMD $cmd\n" ;
+
+ @cmd = split ' ', $cmd ;
+
+ s/:/: / for @cmd ;
+
+ fork_exec( @cmd ) ;
+ sleep 4 unless $cmd =~ /localhost/ ;
+}
+
+
+while( <STDIN> ) {
+
+ next unless /^q/i ;
+
+ cleanup() ;
+}
+
+sub cleanup {
+
+ print "clean up\n" ;
+
+ kill 9, @children ;
+
+ wait ;
+ exit ;
+
+}
+
+sub fork_exec {
+
+ my( @exec ) = @_ ;
+
+ if ( $pid = fork() ) {
+
+ push @children, $pid ;
+ return ;
+ }
+
+ exec @exec ;
+}
--- /dev/null
+#!/usr/local/bin/perl -w
+# File: bin/run_stem
+
+# This file is part of Stem.
+# Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
+
+# Stem is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# Stem is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with Stem; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# For a license to use the Stem under conditions other than those
+# described here, to purchase support for this software, or to purchase a
+# commercial warranty contract, please contact Stem Systems at:
+
+# Stem Systems, Inc. 781-643-7504
+# 79 Everett St. info@stemsystems.com
+# Arlington, MA 02474
+# USA
+
+$Data::Dumper::Indent = 1 ;
+$Data::Dumper::Purity = 1 ;
+$Data::Dumper::Useqq = 1 ;
+
+$| = 1 ;
+
+#print "RUN STEM $0\n" ;
+
+my @conf_args ;
+
+# we set Stem's default environment before we load any Stem modules so
+# they can use those values
+
+use Stem::InstallConfig ;
+
+BEGIN {
+ my $env_text ;
+ my $stem_lib_dir = $Stem::InstallConfig::Config{'conf_path'} ;
+
+ my $is_win32 = $^O =~ /Win32/i ;
+
+# get the site env and home env files
+
+ my @env_files = "$stem_lib_dir/env" ;
+
+ unless ( $is_win32 ) {
+
+ push @env_files, ( $ENV{HOME} ||
+ $ENV{LOGDIR} ||
+ (getpwuid($>))[7] ) . '/.stem_env' ;
+ }
+
+ foreach my $env_file ( @env_files ) {
+
+ next unless -r $env_file ;
+
+# shut up a dumb warning
+ use vars '*ARGVOUT' ;
+ $env_text .=
+ do { local( @ARGV, $/ ) = $env_file ; <> } ;
+ }
+
+
+# set the starting %env from the files
+
+ %Stem::Vars::Env = $env_text =~ /^([^=]+)=(.+)$/mg if $env_text ;
+
+
+# set the %Stem::Vars::Env from %ENV any %ENV name starting with STEM_
+# is used. the STEM_ is deleted and the rest of the lower case name is
+# used with the %ENV value
+
+ /^STEM_(\w+)/ and $Stem::Vars::Env{ lc $1 } = $ENV{ $_ } for keys %ENV ;
+
+# set %Stem::Vars::Env from 'name=value' command line args
+# all other args are assumed to be conf file names.
+# we do this after we process %ENV so the command line args can override
+# any shell environment values
+
+ while( @ARGV ) {
+
+ my $arg = shift ;
+
+ if ( $arg =~ /([^=]+)=(.*)/ ) {
+
+ $Stem::Vars::Env{ $1 } = $2 ;
+ next ;
+ }
+
+ push @conf_args, $arg ;
+ }
+
+# set the default config search path. this will be changed by the install
+# script.
+
+ $Stem::Vars::Env{ 'conf_path' } ||= 'conf:.' ;
+
+# set the trace levels
+
+# $Stem::Vars::Env{ 'MainTraceStatus' } ||= 1 ;
+# $Stem::Vars::Env{ 'MainTraceError' } ||= 1 ;
+# $Stem::Vars::Env{ 'ProcTraceStatus' } ||= 1 ;
+# $Stem::Vars::Env{ 'ProcTraceError' } ||= 1 ;
+# $Stem::Vars::Env{ 'PortalTraceStatus' } ||= 1 ;
+# $Stem::Vars::Env{ 'PortalTraceError' } ||= 1 ;
+# $Stem::Vars::Env{ 'SockMsgTraceStatus' } ||= 1 ;
+# $Stem::Vars::Env{ 'SockMsgTraceError' } ||= 1 ;
+# $Stem::Vars::Env{ 'ConfTraceStatus' } ||= 1 ;
+# $Stem::Vars::Env{ 'ConfTraceError' } ||= 1 ;
+# $Stem::Vars::Env{ 'LogTraceStatus' } ||= 1 ;
+# $Stem::Vars::Env{ 'LogTraceError' } ||= 1 ;
+# $Stem::Vars::Env{ 'CellTraceStatus' } ||= 0 ;
+# $Stem::Vars::Env{ 'CronTraceStatus' } ||= 1 ;
+# $Stem::Vars::Env{ 'CronTraceError' } ||= 1 ;
+# $Stem::Vars::Env{ 'EventTraceStatus' } ||= 0 ;
+# $Stem::Vars::Env{ 'EventTraceError' } ||= 0 ;
+# $Stem::Vars::Env{ 'GatherTraceStatus' } ||= 1 ;
+# $Stem::Vars::Env{ 'GatherTraceError' } ||= 1 ;
+# $Stem::Vars::Env{ 'HubTraceStatus' } ||= 1 ;
+# $Stem::Vars::Env{ 'HubTraceError' } ||= 1 ;
+# $Stem::Vars::Env{ 'TailTraceStatus' } ||= 1 ;
+# $Stem::Vars::Env{ 'TailTraceError' } ||= 1 ;
+# $Stem::Vars::Env{ 'MsgTraceError' } ||= 1 ;
+# $Stem::Vars::Env{ 'MsgTraceStatus' } ||= 1 ;
+# $Stem::Vars::Env{ 'MsgTraceMsg' } ||= 1 ;
+# $Stem::Vars::Env{ 'SwitchTraceStatus' } ||= 1 ;
+# $Stem::Vars::Env{ 'SwitchTraceError' } ||= 1 ;
+# $Stem::Vars::Env{ 'AsynchIOTraceStatus'} ||= 1 ;
+# $Stem::Vars::Env{ 'AsynchIOTraceError' } ||= 1 ;
+# $Stem::Vars::Env{ 'TtyMsgTraceStatus' } ||= 1 ;
+# $Stem::Vars::Env{ 'TtyMsgTraceError' } ||= 1 ;
+
+}
+
+# we load Stem after we process the command line args and %ENV so the
+# modules can use those values
+
+use Stem ;
+
+use Stem::Trace 'log' => 'stem_status',
+ 'sub' => 'TraceStatus',
+ 'env' => 'MainTraceStatus' ;
+
+my $prog_name = $0 ;
+
+$prog_name =~ s|.+/|| ;
+
+unless ( @conf_args ) {
+
+ $prog_name eq 'run_stem' &&
+ die "run_stem must be passed a stem config file" ;
+
+ @conf_args = $prog_name ;
+}
+
+# always start with the site config file
+# this defines site wide configuration settings that are internal
+# to Stem
+
+my $err = Stem::Conf::load_confs( 'site' ) ;
+
+# ignore a missing site config
+
+die $err if defined $err && $err !~ /Can't find config/ ;
+
+$err = Stem::Conf::load_confs( @conf_args ) ;
+
+TraceStatus "Stem startup" ;
+
+TraceStatus $err if $err;
+
+die $err if $err ;
+
+###############
+# this should use Stem::Event
+###############
+$SIG{ 'INT' } = sub {
+ TraceStatus "INT signal received" ;
+ Stem::Event::stop_loop()
+} ;
+
+Stem::Event::start_loop() ;
+
+TraceStatus "Stem shutdown" ;
+
+exit;
+
+=head1 run_stem - Start up Stem and load configuration files
+
+=head2 Synopsis
+
+ run_stem foo=bar stem_conf_file
+
+This script is the way most Stem applications are started. It does
+several important things so you don't have to create your own top
+level scripts. It is not required to execute run_stem to use Stem but
+it makes it much easier to get it going in most cases. The following
+are the steps that 'run_stem' does when bringing up Stem.
+
+=head2 * Load Stem Environment
+
+Many Stem modules and cells look at the Stem environment for default
+configuration values or global flags. This allows you to control how
+many of the cells and modules behave when loaded and instantiated. If
+a Stem attribute in a specification has its 'env' name description
+set, it will use that name (optionally prefixed with the cell's
+registration name) as a key to lookup in the Stem Environement. If
+found there, that value becomes is used and overrides the default and
+any value set in a configuration file. This allows the user to
+override default setting from the outside without modifying Stem
+configuration files. See Stem::Class for more on this. The Stem
+environment is set from these sources in the following order:
+
+=over 4
+
+=item Global Site Environment File
+
+'run_stem' initially looks for a file named 'env' in the first
+configuration directory (set at install time) and loads it if
+found. These site and user files both have a simple key=value format
+with one entry per line.
+
+=item User Environment File
+
+'run_stem' then will look in your home directory (not supported on
+windows) for a file named .stem_env and loads it if found.
+
+=item Shell Environment
+
+Any shell environment variable with the form 'STEM_*' will
+have the 'STEM_' part deleted and the rest of its name
+converted to lower case. That will become the key in the Stem
+environment with the value set to the shell variable's value.
+
+=item Command Line
+
+Any command line arguments of the form key=value will be
+parsed out and used to set a Stem environment variable.
+
+=back
+
+=head2 * Load Stem Core Modules
+
+ 'run_stem' then loads all the core Stem modules with a use
+ Stem line.
+
+=head2 * Load Configuration Files
+
+Any arguments left in @ARGV are assumed to be Stem configuration
+files. Typically there is only one configuration file but you can have
+pass in as many as you want. The config file arguments can have a
+.stem suffix or no suffix. The configuration directory list is
+searched in order for the file and it is loaded and all of its entries
+are constructed.
+
+You can override the default configuration directory list (set at
+install time) by setting the 'conf_path' Stem environment variable
+from the shell environment or on the 'run_stem' command line. The
+following are equivilent:
+
+ export STEM_CONF_PATH=/etc/stem/conf:/home/foo/.stem
+ run_stem bar
+
+ run_stem conf_path=/etc/stem/conf:/home/foo/.stem bar
+
+=head2 * Start Event Loop
+
+The final operation 'run_stem' does is start the main event
+loop. If no events were created by the loaded configuration
+files, this will fail and 'run_stem will exit immediately. If
+all the created events eventually get canceled, the event loop
+will exit and 'run_stem' will exit too.
+
+=cut
--- /dev/null
+#!/usr/local/bin/perl -w
+#
+# stem2pod
+#
+# takes filename (a stem module) arguments and it updates their
+# pod from their attribute descriptions. it also will insert pod
+# templates for methods, subs and standard pod sections.
+#
+# if a file is changed, it is written out over itself. unchanged
+# files are not touched.
+
+use strict;
+
+use Carp qw( carp cluck ) ;
+use Data::Dumper;
+
+#use Test::More tests => 1 ;
+
+#$SIG{__WARN__} = sub { cluck } ;
+
+my $changed ;
+my $package ;
+
+my %is_attr_part = map { $_ => 1 } qw(
+ name
+ type
+ help
+ default
+ required
+ class
+ class_args
+) ;
+
+foreach my $file_name ( @ARGV ) {
+
+ process_source_file( $file_name ) ;
+}
+
+exit ;
+
+sub process_source_file {
+
+ my ( $file_name ) = @_ ;
+
+ my $code_text = read_file( $file_name ) ;
+
+ my $new_code_text = process_code_text( $file_name, $code_text ) ;
+
+#print $new_code_text ;
+
+ if ( $new_code_text eq $code_text ) {
+
+ print "$file_name SAME\n" ;
+ return ;
+ }
+
+ print "$file_name CHANGED\n" ;
+
+ write_file( "$file_name.new, $new_code_text ) ;
+
+# write_file( "$file_name.bak, $code_text ) ;
+# write_file( $file_name, $new_code_text ) ;
+
+}
+
+sub process_code_text {
+
+ my ( $file_name, $text ) = @_ ;
+
+ $text =~ s{
+ (
+ ^package # start at package line
+ .+? # the middle stuff
+ ^sub # start of constructor
+ )
+ }
+ {
+ update_attr_spec( $1, $file_name )
+ }mgsex ;
+
+ $text =~ s{
+ (.{0,20}?)
+ ^sub
+ \s+
+ (\w+)
+ \s*
+ }
+ { update_sub_pod( $1, $2 ) }mgsex ;
+
+ unless( $text =~ /^=cut\s*^\s*1\s*;\s*/m ) {
+
+ $text =~ s{^\s*1\s*;\s*$}{ update_trailing_pod() }mex ;
+ }
+
+ return $text ;
+}
+
+
+sub update_attr_spec {
+
+ my( $attr_text, $file_name ) = @_ ;
+
+#print "U1 <$attr_text>\n" ;
+
+ ( $package ) = $attr_text =~ /^package\s+([\w:]+)/ ;
+
+ $attr_text =~ s/\n*^\#{5,}\n.+?^\#{5,}\n*//ms ;
+# and print "DELETED OLD POD\n" ;
+
+#print "U3 <$attr_text>\n" ;
+
+ $attr_text =~ s{ (^my\s+\$attr_spec.+?^]\s*;\s*) }
+ { attr_spec_to_pod( $1, $file_name ) }gmsex ;
+
+#dump_attr( 'ATTR', $attr_text ) ;
+#print "ATTR [", substr( $attr_text, -40 ), "]\n" ;
+#print "U2 [$attr_text]\n" ;
+
+ return $attr_text ;
+}
+
+sub attr_spec_to_pod {
+
+ my ( $attr_text, $file_name ) = @_ ;
+
+ my $pod ;
+
+#print "ATTR [$attr_text]\n" ;
+#print "ATTR END1 [", substr( $attr_text, -30), "]\n" ;
+
+ $attr_text =~ s/\s*\z// ;
+
+ my( $attr_list_text ) =
+ $attr_text =~ /^my\s+\$attr_spec.+?=(.+?^\])/ms ;
+ $attr_list_text or die
+ "can't parse out attr list from file $file_name class $package" ;
+
+#print "ATTR2 [$attr_list_text]\n" ;
+ my $attr_list = eval $attr_list_text ;
+
+ $pod .= <<POD ;
+###########
+# This POD section is autogenerated. Any edits to it will be lost.
+
+=head2 Class Attributes for $package
+
+=over 4
+
+POD
+
+#print "POD [$pod]\n" ;
+
+
+ foreach my $attr_ref ( @{$attr_list} ) {
+
+ my $name = $attr_ref->{name} ;
+
+ if ( $name ) {
+
+ $pod .= <<POD ;
+
+=item * Attribute - B<$name>
+
+=over 4
+
+POD
+ }
+ else {
+
+ warn <<WARN ;
+Missing attribute name in Class $package in file $file_name
+WARN
+
+ next ;
+ }
+
+ my $help = $attr_ref->{help} ;
+
+ if ( defined( $help ) ) {
+
+ $pod .= <<POD ;
+
+=item Description:
+
+$help
+POD
+ }
+ else {
+
+ warn <<WARN ;
+Missing help in attribute $name in Class $package in file $file_name
+WARN
+ }
+
+ if ( my $attr_class = $attr_ref->{class} ) {
+
+ my $class_args = '<' .
+ join( ', ', @{$attr_ref->{class_args} || []} )
+ . '>' ;
+
+ $pod .= <<POD ;
+
+=item Class Attribute:
+
+'$name' is an object of class $attr_class and constructed with:
+$class_args
+POD
+ }
+
+
+ exists( $attr_ref->{type} ) and $pod .= <<POD ;
+
+=item The type of '$name' is:
+
+$attr_ref->{type}
+POD
+
+ if ( exists( $attr_ref->{default} ) ) {
+
+ my $default = $attr_ref->{default} ;
+
+ if( ref($default) eq "ARRAY" ) {
+
+ $default =
+ '(' . join( ', ', @{$default} ) . ')' ;
+ }
+
+ $pod .= <<POD
+
+=item B<Default> value:
+
+$default
+POD
+ }
+
+ exists( $attr_ref->{required} ) and $pod .= <<POD ;
+
+=item It is B<required>.
+POD
+
+ foreach my $attr ( sort keys %{ $attr_ref } ) {
+ next if $is_attr_part{ $attr } ;
+ $pod .= "Unknown attribute $attr\n" ;
+ }
+
+ $pod .= <<POD ;
+
+=back
+
+POD
+ }
+
+ $pod .= <<POD ;
+
+=back
+
+=cut
+
+# End of autogenerated POD
+###########
+
+POD
+
+#print "[$pod]" ;
+#print "POD2 [", substr($pod, 0, 40), "]\n" ;
+
+ return "$attr_text\n\n$pod" ;
+}
+
+sub update_sub_pod {
+
+ my( $cut_text, $name ) = @_ ;
+
+#print "SUB [$cut_text][$name]\n" ;
+
+ if ( $cut_text =~ /^=cut\s*$/m || $name =~ /^_/ ) {
+
+#print "SUB1 [${cut_text}sub $name ]\n" if $name eq 'new' ;
+#dump_new( 'POD FOUND', $cut_text ) ;
+
+ return "${cut_text}sub $name " ;
+ }
+
+#print "NO SUB POD for $name\n" ;
+
+ my $desc = get_sub_pod( $name ) ;
+
+#dump_new( 'CUT', $cut_text ) ;
+#dump_new( 'DESC', $desc ) ;
+#print "CUT2 [$cut_text]\nDESC [$desc]\n" if $name eq 'new' ;
+
+ my $pod = <<POD ;
+$cut_text$desc
+=cut
+
+sub $name
+POD
+
+ chomp $pod ;
+
+#print "SUB2 [$pod]\n" if $name eq 'new' ;
+
+ return $pod ;
+}
+
+sub get_sub_pod {
+
+ my ( $name ) = @_ ;
+
+ return <<POD if $name eq 'new' ;
+=head3 Constructor - B<new>
+
+The B<new> method creates an object of the class B<$package>.
+
+POD
+
+ return <<POD if $name eq 'msg_in' ;
+=head3 Message Handler - B<msg_in>
+
+The B<msg_in> method is effectively a default method for message
+delivery. If any message to this cell can't be delivered to another
+method, then it will be delivered to the B<msg_in> method. If a
+command message is delivered and a value is returned by B<msg_in>, a
+response message is sent back to the originating cell with that value.
+POD
+
+ return <<POD if $name =~ /(\w+)_in$/ ;
+=head3 Message Handler - $name
+
+B<$1> type messages are delivered to this method. Its return value is
+ignored by the message delivery system.
+POD
+
+ return <<POD if $name =~ /(\w+)_cmd$/ ;
+=head3 Command Message Handler - $name
+
+B<$1> command messages are delivered to this method. If any value is
+returned, the message delivery system will create a response type
+message and dispatch it back to the sending cell.
+POD
+
+ return <<POD ;
+=head3 Method - $name
+POD
+
+}
+
+sub update_trailing_pod {
+
+ my( $tail_text ) = @_ ;
+
+# return $tail_text if $tail_text =~ /=cut/ ;
+
+#print "1 [$tail_text]\n" ;
+
+ return <<POD ;
+
+=head1 Bugs
+
+=head1 Todo
+
+=head1 See Also
+
+=head1 Author
+
+Uri Guttman, E<lt>uri\@stemsystems.comE<gt>
+
+=cut
+
+1 ;
+POD
+
+}
+
+sub read_file {
+
+ my( $file_name ) = shift ;
+
+ local( *FH ) ;
+ open( FH, $file_name ) || carp "can't open $file_name $!" ;
+
+ return <FH> if wantarray ;
+
+ my $buf ;
+
+ sysread( FH, $buf, -s FH ) ;
+ return $buf ;
+}
+
+sub write_file {
+
+ my( $file_name ) = shift ;
+
+ local( *FH ) ;
+
+ open( FH, ">$file_name" ) || carp "can't create $file_name $!" ;
+
+ print FH @_ ;
+}
+
+sub dump_attr {
+
+ my( $key, $text ) = @_ ;
+
+ $text =~ /(;\s+#{3,})/s or return ;
+
+ print "$key [$1]\n" ;
+}
+
+__END__
--- /dev/null
+#!/usr/local/bin/perl
+
+use Getopt::Long ;
+use strict ;
+
+use Stem ;
+
+my %args ;
+my $hub_name ;
+my $portal ;
+
+parse_args() ;
+
+setup_hub() ;
+
+send_msg() ;
+
+Stem::Event::start_loop() ;
+
+# no return from here.
+######################
+
+sub setup_hub {
+
+ $hub_name = "Stem_msg_$$" ;
+
+ Stem::Route::register_class( __PACKAGE__ ) ;
+
+ Stem::Hub->new( 'reg_name' => $hub_name ) ;
+
+ my @portal_args ;
+
+ push @portal_args, ( 'host' => $args{'host'} ) if $args{'host'} ;
+ push @portal_args, ( 'port' => $args{'port'} ) if $args{'port'} ;
+
+#print "portal args: @portal_args\n" ;
+
+ $portal = Stem::Portal->new( @portal_args ) ;
+
+ die "Can't create Portal: $portal" if $portal ;
+}
+
+sub send_msg {
+
+ my ( @msg_args, @target ) ;
+
+ if ( $args{'cmd'} ) {
+
+ @msg_args = ( 'type' => 'cmd', 'cmd' => $args{'cmd'} ) ;
+ }
+ else {
+
+ @msg_args = ( 'type' => 'data' ) ;
+ }
+
+ @target = ( 'to_target' => $args{'target'} ) if $args{'target'} ;
+
+ push( @msg_args, ( 'ack_req' => 1 ) ) if $args{'ack'} ;
+
+ my $data = exists( $args{'data'} ) ? $args{'data'} : '' ;
+
+ my $msg = Stem::Msg->new(
+ 'to_hub' => 'DEFAULT',
+ 'to_cell' => $args{'cell'},
+ @target,
+ 'from_cell' => __PACKAGE__,
+ 'from_hub' => $hub_name,
+ 'data' => \$data,
+ @msg_args,
+ ) ;
+
+ $msg->dispatch() ;
+}
+
+# this is the class method that gets back the response and ack messages.
+
+sub msg_in {
+
+ my( $class, $msg ) = @_ ;
+
+ if( $msg->type() eq 'msg_ack' ) {
+
+# print "ACK\n" ;
+ exit ;
+ }
+
+ if ( my $data = $msg->data() ) {
+
+ print ${$data} ;
+ }
+
+# $portal->shut_down() ;
+
+ exit unless $args{'ack'} ;
+
+ return ;
+}
+
+
+sub parse_args {
+
+ Getopt::Long::Configure( 'no_ignore_case' ) ;
+
+ GetOptions( \%args,
+ 'cell|C=s',
+ 'hub|H=s',
+ 'target|T=s',
+ 'cmd|c=s',
+ 'data|d=s',
+ 'ack|a',
+ 'host|h=s',
+ 'port|p=s',
+ 'help|?',
+ ) ;
+
+#print map "$_ => $args{$_}\n", sort keys %args ;
+
+ usage( '' ) if $args{ 'help' } ;
+
+ usage( 'Missing Cell address' ) unless $args{ 'cell' } ;
+}
+
+sub usage {
+
+ my $err_msg = shift ;
+
+ my $usage = <<'=cut' ;
+=pod
+
+=head1 NAME
+
+stem_msg - Inject a message into a Stem Hub
+
+=head1 SYNOPSIS
+
+stem_msg -cell <cell> [-hub <hub>] [-target <target>]
+ [-cmd <cmd>] [-data <data>] [-ack]
+ [-host <host>] [-port <port>]
+
+ -C <cell> The Stem Cell to send this message to.
+ -cell <cell> This is required.
+
+ -H <hub> The hub which has the addressed Stem Cell.
+ -hub <hub>
+
+ -T <target> The target address of the Stem Cell
+ -target <target>
+
+ -c <cmd> The cmd type to send in the message
+ -cmd <cmd> If no cmd is set, it will be a data type
+ message.
+
+ -d <data> The data to be sent in the message.
+ -data <data> Default is an empty string.
+
+ -a Wait for an acknowledge message before
+ -ack exiting.
+
+ -h <host> The host which the Stem Hub is on.
+ -host <host> Default: localhost
+
+ -p <port> The port which the Stem Portal is listening
+ -port <port> to.
+ Default: 10,000 (probably will change)
+
+=head1 DESCRIPTION
+
+This program is meant to inject a single message into a Stem Hub. You
+set the Cell address with the command line options and then which
+command to execute in that Cell. If you don't set a command, then a
+data message will be sent. You can send data in the message as well.
+
+If the Cell generates a response message, then its data will be
+printed on stdout.
+
+If the -ack option is set, then the message will have the ack_req flag
+will be set in the outgoing message. This will cause an 'ack' type
+message to be sent back after the original message has been
+delivered. This is meant for when you send a message to a Cell which
+doesn't generate a response. It lets this program know that it can
+exit.
+
+=cut
+
+ $usage =~ s/^=\w+.*$//mg ;
+
+ $usage =~ s/\n{2,}/\n\n/ ;
+ $usage =~ s/\A\n+/\n/ ;
+
+ die "$err_msg\n$usage" ;
+}
--- /dev/null
+#!/usr/local/bin/perl -s
+
+$line_cnt = 10 ;
+$offset = 175 ;
+$base_off = 0 ;
+$xskip = ( $^O eq 'solaris' ) ? 600 : 500 ;
+
+my @children ;
+
+my $tail_dir = 'tail' ;
+
+$SIG{ 'INT' } = \&cleanup ;
+
+if ( $s ) {
+
+ $ssfe = 'ssfe' ;
+ $prompt = '-prompt Stem:' ;
+ $echo = 'console_echo=1'
+}
+
+-d $tail_dir or mkdir $tail_dir, 0722 or
+ die "can't create $tail_dir working directory" ;
+
+foreach my $log ( qw( foo bar bar_status ) ) {
+ unlink "$tail_dir/$log.log" ;
+}
+
+
+foreach $cmd ( split /\n/, <<EOT ) {
+xterm -T Archive -n Archive -geometry 80x35+0+0 -e $ssfe $prompt run_stem $echo archive
+xterm -T Monitor -n Monitor -geometry 80x35+$xskip+0 -e $ssfe $prompt run_stem $echo monitor
+xterm -T Tail -n Tail -geometry 80x20+275+420
+EOT
+
+ print "$cmd\n" ;
+
+ @cmd = split ' ', $cmd ;
+
+ s/:/: / for @cmd ;
+
+ chdir $tail_dir unless $cmd =~ /run_stem/ ;
+
+ fork_exec( @cmd ) ;
+
+ sleep 2 ;
+}
+
+while( <STDIN> ) {
+
+ next unless /^q/i ;
+
+ cleanup() ;
+}
+
+sub cleanup {
+
+ print "clean up\n" ;
+
+ kill 9, @children ;
+ wait ;
+ exit ;
+
+}
+
+sub fork_exec {
+
+ my( @exec ) = @_ ;
+
+ if ( $pid = fork() ) {
+
+ push @children, $pid ;
+ return ;
+ }
+
+ exec @exec ;
+}
--- /dev/null
+Certificate:
+ Data:
+ Version: 1 (0x0)
+ Serial Number: 1 (0x1)
+ Signature Algorithm: md5WithRSAEncryption
+ Issuer: C=US, ST=Some-State, O=Dummy IO::Socket::SSL Certificate Authority, CN=Dummy IO::Socket::SSL Certificate Authority
+ Validity
+ Not Before: Jul 20 16:06:19 2002 GMT
+ Not After : Dec 5 16:06:19 2029 GMT
+ Subject: C=US, ST=Some-State, O=IO::Socket::SSL Dummy Certificate, CN=IO::Socket::SSL Dummy Certificate
+ Subject Public Key Info:
+ Public Key Algorithm: rsaEncryption
+ RSA Public Key: (512 bit)
+ Modulus (512 bit):
+ 00:cd:65:60:3d:8f:55:1f:7a:9e:87:a8:72:a0:53:
+ 9d:e9:31:9e:bc:f1:27:d3:ba:e9:ab:ca:28:a5:b5:
+ 48:a2:24:d8:ed:01:ec:ae:69:b1:91:7b:68:e6:d1:
+ 15:57:7e:b0:06:62:33:d5:88:3e:fc:dc:fb:db:8a:
+ c9:9b:bb:50:9f
+ Exponent: 65537 (0x10001)
+ Signature Algorithm: md5WithRSAEncryption
+ 0b:61:be:f8:12:9a:82:92:63:ed:57:f8:f9:dd:79:1b:46:a2:
+ 0c:7c:a0:80:01:88:38:0f:a1:c0:b3:2d:57:0e:ad:3c:a8:72:
+ e3:d9:50:7f:11:9a:af:2a:e3:d8:66:de:b2:18:3e:cf:c5:4a:
+ 71:00:b0:05:49:a3:83:9a:53:f9:83:92:2f:c7:f7:d3:df:8f:
+ 3d:92:5c:e5:3e:5a:f8:b6:55:71:5e:c8:85:a4:0c:0f:e7:1b:
+ 1f:b9:c9:db:c4:9e:d8:6a:fc:33:da:10:36:de:73:34:2f:ea:
+ 0d:29:e1:2b:90:89:a3:a9:74:8c:57:e3:ee:50:00:b4:0c:69:
+ 1a:f2
+-----BEGIN CERTIFICATE-----
+MIICNDCCAZ0CAQEwDQYJKoZIhvcNAQEEBQAwgY4xCzAJBgNVBAYTAlVTMRMwEQYD
+VQQIEwpTb21lLVN0YXRlMTQwMgYDVQQKEytEdW1teSBJTzo6U29ja2V0OjpTU0wg
+Q2VydGlmaWNhdGUgQXV0aG9yaXR5MTQwMgYDVQQDEytEdW1teSBJTzo6U29ja2V0
+OjpTU0wgQ2VydGlmaWNhdGUgQXV0aG9yaXR5MB4XDTAyMDcyMDE2MDYxOVoXDTI5
+MTIwNTE2MDYxOVowejELMAkGA1UEBhMCVVMxEzARBgNVBAgTClNvbWUtU3RhdGUx
+KjAoBgNVBAoTIUlPOjpTb2NrZXQ6OlNTTCBEdW1teSBDZXJ0aWZpY2F0ZTEqMCgG
+A1UEAxMhSU86OlNvY2tldDo6U1NMIER1bW15IENlcnRpZmljYXRlMFwwDQYJKoZI
+hvcNAQEBBQADSwAwSAJBAM1lYD2PVR96noeocqBTnekxnrzxJ9O66avKKKW1SKIk
+2O0B7K5psZF7aObRFVd+sAZiM9WIPvzc+9uKyZu7UJ8CAwEAATANBgkqhkiG9w0B
+AQQFAAOBgQALYb74EpqCkmPtV/j53XkbRqIMfKCAAYg4D6HAsy1XDq08qHLj2VB/
+EZqvKuPYZt6yGD7PxUpxALAFSaODmlP5g5Ivx/fT3489klzlPlr4tlVxXsiFpAwP
+5xsfucnbxJ7Yavwz2hA23nM0L+oNKeErkImjqXSMV+PuUAC0DGka8g==
+-----END CERTIFICATE-----
--- /dev/null
+-----BEGIN RSA PRIVATE KEY-----
+Proc-Type: 4,ENCRYPTED
+DEK-Info: DES-EDE3-CBC,A24532ADA3AB45E3
+
+sltzmMEb/cKphkOkMQsMJHyqc17pxXf3z3QrvktJRvZQtMU6dY0eisbW3gilU+80
+qgiMkkD9TEufYQ3oLRAF8hefS+iM+Mx3F5Ml5bhArXQBRN6Gd0QkepWnrrko8Y6N
+6uGT9ndJHhLyOArDWgWkzfuT7NEVoYrLhf8x6E43v/6By5GmBZs5mbwygYr6vpzZ
+6+KHgpVFYPNQvhJTKJTe2XO+kTQtOcYmrapTr6SG4i9i7x2Q21CGhum8492KA+3N
++EvmGAp0MMwZVTuCRyquLRfF6/NsPANb97yWsz3pe05I/p8CSzwU7ivNQZA51pyx
+zlwzjoWElSzMTssIegcCctdjeTHhiFRfvW1YDinvXPiLfAjBOv37JDvLC6vclqev
+yPXtne0iOn8hZc0QAnWESAAPz6PE0jIecqcZkXKQHfc=
+-----END RSA PRIVATE KEY-----
--- /dev/null
+-----BEGIN RSA PRIVATE KEY-----
+MIIBOQIBAAJBAM1lYD2PVR96noeocqBTnekxnrzxJ9O66avKKKW1SKIk2O0B7K5p
+sZF7aObRFVd+sAZiM9WIPvzc+9uKyZu7UJ8CAwEAAQJAdCtxWoAWCh7lSR8J7go9
+Fya8fGr9NrDR9xr5EHhPI30lmzpj1Tst2VRymN8ojUu/3AgBAOshpqS5Ve38o2mU
+yQIhAPd44uw37QTwmefTWV+REtaGHaRwbc5qemSV6WNpgei9AiEA1HlOzr1BxqCo
+ZwlizSn5ox8YdJ6LAOA+1GOkvOyV2osCIGT26w4Y2xiy2PfeII5+78KaQSm/vO0E
+QB8dknS+rQO5AiBwv6KjMGjsFyrl6mQkjOasuf6HO+51W4nbuLidjEoE+wIgN00d
+/WcCSyj8HlfLgHPe8ZlEyMe6Hq7LfX5lShUq0qI=
+-----END RSA PRIVATE KEY-----
--- /dev/null
+-----BEGIN CERTIFICATE-----
+MIIDgzCCAuygAwIBAgIBADANBgkqhkiG9w0BAQQFADCBjjELMAkGA1UEBhMCVVMx
+EzARBgNVBAgTClNvbWUtU3RhdGUxNDAyBgNVBAoTK0R1bW15IElPOjpTb2NrZXQ6
+OlNTTCBDZXJ0aWZpY2F0ZSBBdXRob3JpdHkxNDAyBgNVBAMTK0R1bW15IElPOjpT
+b2NrZXQ6OlNTTCBDZXJ0aWZpY2F0ZSBBdXRob3JpdHkwHhcNMDIwNzIwMTYwNTU0
+WhcNMjkxMjA1MTYwNTU0WjCBjjELMAkGA1UEBhMCVVMxEzARBgNVBAgTClNvbWUt
+U3RhdGUxNDAyBgNVBAoTK0R1bW15IElPOjpTb2NrZXQ6OlNTTCBDZXJ0aWZpY2F0
+ZSBBdXRob3JpdHkxNDAyBgNVBAMTK0R1bW15IElPOjpTb2NrZXQ6OlNTTCBDZXJ0
+aWZpY2F0ZSBBdXRob3JpdHkwgZ8wDQYJKoZIhvcNAQEBBQADgY0AMIGJAoGBALQm
+bgkEUWImNkjWcO6qn5NZ7rCFbtrzqEYbqciy+1qlWuoBgU44n9ykD1c/BcmBPsDT
+bIOfLzjcdJj38taXu7kcRclchJ+/c6o/SmDv7UqcL6QgVSZRvRrK7TDypMqe3sW8
+zCvTF8WtSsgFy5f9qlUdx4NowMzVV7OFl+6x4YlpAgMBAAGjge4wgeswHQYDVR0O
+BBYEFDU4SrHVMHDjd2kBgFM/qyC3DPxFMIG7BgNVHSMEgbMwgbCAFDU4SrHVMHDj
+d2kBgFM/qyC3DPxFoYGUpIGRMIGOMQswCQYDVQQGEwJVUzETMBEGA1UECBMKU29t
+ZS1TdGF0ZTE0MDIGA1UEChMrRHVtbXkgSU86OlNvY2tldDo6U1NMIENlcnRpZmlj
+YXRlIEF1dGhvcml0eTE0MDIGA1UEAxMrRHVtbXkgSU86OlNvY2tldDo6U1NMIENl
+cnRpZmljYXRlIEF1dGhvcml0eYIBADAMBgNVHRMEBTADAQH/MA0GCSqGSIb3DQEB
+BAUAA4GBAIbCsK/qUXiIsRvg1ptaLNM6VsuR8ifNrmo9A4zk1h4OCixys6Hmoow6
+3MndnLpD3rh3UCYh0M20+fiHcwSmHZvBo3dfSSvYnH0gFSBjKp/wgGcb3Cvl3dRX
+aeWZGrKQKLI6DrHqAiSu9rv+2kfzgmRLt0K+gdb2GkQqCBwT8Gjr
+-----END CERTIFICATE-----
--- /dev/null
+Certificate:
+ Data:
+ Version: 1 (0x0)
+ Serial Number: 2 (0x2)
+ Signature Algorithm: md5WithRSAEncryption
+ Issuer: C=US, ST=Some-State, O=Dummy IO::Socket::SSL Certificate Authority, CN=Dummy IO::Socket::SSL Certificate Authority
+ Validity
+ Not Before: Jul 20 16:06:37 2002 GMT
+ Not After : Dec 5 16:06:37 2029 GMT
+ Subject: C=US, ST=Some-State, O=IO::Socket::SSL Dummy Server Certificate, CN=IO::Socket::SSL Dummy Server Certificate
+ Subject Public Key Info:
+ Public Key Algorithm: rsaEncryption
+ RSA Public Key: (512 bit)
+ Modulus (512 bit):
+ 00:9f:27:5f:4a:8a:35:4a:7f:3f:d1:80:25:96:26:
+ 0a:da:af:9a:6d:bc:23:ba:71:91:5b:40:d1:2d:2b:
+ c8:60:2a:ef:e9:54:e5:a2:64:0a:57:90:35:bf:cd:
+ b6:36:f3:25:53:68:65:2c:d8:d0:f9:b7:f3:7f:2e:
+ f8:e2:3d:e0:dd
+ Exponent: 65537 (0x10001)
+ Signature Algorithm: md5WithRSAEncryption
+ 57:a7:2d:91:cc:e9:11:16:bb:c1:cd:b5:a5:e1:26:99:8f:ee:
+ 8c:b0:2d:b6:54:f4:8a:8e:fd:8f:45:9a:68:d8:0e:ef:d6:a5:
+ 38:6a:48:d0:08:da:a8:87:3c:70:05:18:69:a1:c8:ee:94:a7:
+ 87:40:f5:4f:64:b4:b0:c6:d3:d2:ed:f9:cc:d1:fe:da:4d:99:
+ 4d:22:02:f6:0e:9b:c0:cc:42:59:50:2f:5c:fc:5b:70:f9:0b:
+ ec:6e:5b:eb:d7:6f:a1:b8:67:57:b1:4f:99:bd:ad:03:9d:b5:
+ f3:44:5c:36:1c:fa:33:82:87:0b:99:aa:f5:39:5c:63:23:6b:
+ 48:2d
+-----BEGIN CERTIFICATE-----
+MIICQzCCAawCAQIwDQYJKoZIhvcNAQEEBQAwgY4xCzAJBgNVBAYTAlVTMRMwEQYD
+VQQIEwpTb21lLVN0YXRlMTQwMgYDVQQKEytEdW1teSBJTzo6U29ja2V0OjpTU0wg
+Q2VydGlmaWNhdGUgQXV0aG9yaXR5MTQwMgYDVQQDEytEdW1teSBJTzo6U29ja2V0
+OjpTU0wgQ2VydGlmaWNhdGUgQXV0aG9yaXR5MB4XDTAyMDcyMDE2MDYzN1oXDTI5
+MTIwNTE2MDYzN1owgYgxCzAJBgNVBAYTAlVTMRMwEQYDVQQIEwpTb21lLVN0YXRl
+MTEwLwYDVQQKEyhJTzo6U29ja2V0OjpTU0wgRHVtbXkgU2VydmVyIENlcnRpZmlj
+YXRlMTEwLwYDVQQDEyhJTzo6U29ja2V0OjpTU0wgRHVtbXkgU2VydmVyIENlcnRp
+ZmljYXRlMFwwDQYJKoZIhvcNAQEBBQADSwAwSAJBAJ8nX0qKNUp/P9GAJZYmCtqv
+mm28I7pxkVtA0S0ryGAq7+lU5aJkCleQNb/NtjbzJVNoZSzY0Pm3838u+OI94N0C
+AwEAATANBgkqhkiG9w0BAQQFAAOBgQBXpy2RzOkRFrvBzbWl4SaZj+6MsC22VPSK
+jv2PRZpo2A7v1qU4akjQCNqohzxwBRhpocjulKeHQPVPZLSwxtPS7fnM0f7aTZlN
+IgL2DpvAzEJZUC9c/Ftw+Qvsblvr12+huGdXsU+Zva0DnbXzRFw2HPozgocLmar1
+OVxjI2tILQ==
+-----END CERTIFICATE-----
--- /dev/null
+-----BEGIN RSA PRIVATE KEY-----
+Proc-Type: 4,ENCRYPTED
+DEK-Info: DES-EDE3-CBC,25B674CF19D8A5D7
+
+fLLIyUYuJLP0YzaBTMrdHSN9ROApAIyDdZNUM3qOW19IfER87Rw90pTJLTIe2r9d
+tDIBY0w3MCYHOKEC+g9R8nsgLJNEkXG/Zi6fbhufnPAk343X8mDm+hjtQVzZONVc
+VE8v4EA6qYHm54y/UlXnK9fJ9OhFru+btueQ+8z2pYZJEZ9ktAEJBj+jeD9nOcw4
+lZ2vgpGwyj5pzNSS/4QlujRSB4gddPlJyig+STN2iom7BetPUVJg0XOW74ezZSr9
+WU/c8Ghbg/efzah56WUYzBdIhXjpQr5zDmXi6uj8zCLSSFjdR48KQVfbXULoeqeA
+8Nru2tXv34C5UdDgOkKbZSHar0n3o6t73B3WS9i90/1A4VLHvCvNxoBet7JdkEx8
+yv0b3A6wBHtAI5LRryaHAVN7bkIpXCfXGeMGFoCUpdO2jCeg/j54AQ==
+-----END RSA PRIVATE KEY-----
--- /dev/null
+-----BEGIN RSA PRIVATE KEY-----
+MIIBPAIBAAJBAJ8nX0qKNUp/P9GAJZYmCtqvmm28I7pxkVtA0S0ryGAq7+lU5aJk
+CleQNb/NtjbzJVNoZSzY0Pm3838u+OI94N0CAwEAAQJAf/DavcVVCco5t2TY0ldK
+qno4Hrb70cmyHDWC8lkb/5HAGbCGxpsstXxVKczRO201vcFUKm6PX5moUnFCINpg
+UQIhAM+ooHbD0eLL0K6limEnW7GId/+DFI/6KFXk2Nzm//XXAiEAxDQbWQvZS8DO
+HJ5JV8flvMhH30KLeH+zpsvBjWJK4GsCIQCUF7woNsquJZBznNctJjZ8S8jYThES
+BONTLluCXrNYDQIhAJFnsHDQqCxM6jMpV193pJnAsAsUbPpTYZeWX43hL26bAiEA
+jNB3PPNvTNr5tICkO/lMZcN87eUn4ZAtrNzCVF5ilEo=
+-----END RSA PRIVATE KEY-----
--- /dev/null
+-----BEGIN CERTIFICATE-----
+MIIDgzCCAuygAwIBAgIBADANBgkqhkiG9w0BAQQFADCBjjELMAkGA1UEBhMCVVMx
+EzARBgNVBAgTClNvbWUtU3RhdGUxNDAyBgNVBAoTK0R1bW15IElPOjpTb2NrZXQ6
+OlNTTCBDZXJ0aWZpY2F0ZSBBdXRob3JpdHkxNDAyBgNVBAMTK0R1bW15IElPOjpT
+b2NrZXQ6OlNTTCBDZXJ0aWZpY2F0ZSBBdXRob3JpdHkwHhcNMDIwNzIwMTYwNTU0
+WhcNMjkxMjA1MTYwNTU0WjCBjjELMAkGA1UEBhMCVVMxEzARBgNVBAgTClNvbWUt
+U3RhdGUxNDAyBgNVBAoTK0R1bW15IElPOjpTb2NrZXQ6OlNTTCBDZXJ0aWZpY2F0
+ZSBBdXRob3JpdHkxNDAyBgNVBAMTK0R1bW15IElPOjpTb2NrZXQ6OlNTTCBDZXJ0
+aWZpY2F0ZSBBdXRob3JpdHkwgZ8wDQYJKoZIhvcNAQEBBQADgY0AMIGJAoGBALQm
+bgkEUWImNkjWcO6qn5NZ7rCFbtrzqEYbqciy+1qlWuoBgU44n9ykD1c/BcmBPsDT
+bIOfLzjcdJj38taXu7kcRclchJ+/c6o/SmDv7UqcL6QgVSZRvRrK7TDypMqe3sW8
+zCvTF8WtSsgFy5f9qlUdx4NowMzVV7OFl+6x4YlpAgMBAAGjge4wgeswHQYDVR0O
+BBYEFDU4SrHVMHDjd2kBgFM/qyC3DPxFMIG7BgNVHSMEgbMwgbCAFDU4SrHVMHDj
+d2kBgFM/qyC3DPxFoYGUpIGRMIGOMQswCQYDVQQGEwJVUzETMBEGA1UECBMKU29t
+ZS1TdGF0ZTE0MDIGA1UEChMrRHVtbXkgSU86OlNvY2tldDo6U1NMIENlcnRpZmlj
+YXRlIEF1dGhvcml0eTE0MDIGA1UEAxMrRHVtbXkgSU86OlNvY2tldDo6U1NMIENl
+cnRpZmljYXRlIEF1dGhvcml0eYIBADAMBgNVHRMEBTADAQH/MA0GCSqGSIb3DQEB
+BAUAA4GBAIbCsK/qUXiIsRvg1ptaLNM6VsuR8ifNrmo9A4zk1h4OCixys6Hmoow6
+3MndnLpD3rh3UCYh0M20+fiHcwSmHZvBo3dfSSvYnH0gFSBjKp/wgGcb3Cvl3dRX
+aeWZGrKQKLI6DrHqAiSu9rv+2kfzgmRLt0K+gdb2GkQqCBwT8Gjr
+-----END CERTIFICATE-----
--- /dev/null
+# archive.stem
+#
+[
+ class => 'Stem::Console',
+],
+[
+ 'class' => 'Stem::Hub',
+ 'name' => 'archive',
+ 'args' => [],
+],
+[
+ 'class' => 'Stem::Portal',
+ 'args' => [
+ 'server' => 1,
+ ],
+],
+[
+ 'class' => 'Stem::Log',
+ 'args' => [
+
+ 'name' => 'bar',
+
+ 'file' => [
+ 'path' => 'tail/bar.log',
+ ],
+
+ 'filters' => [
+ file => 1,
+ forward => [ 'bar_stdout' ],
+ ],
+
+ ],
+],
+[
+ 'class' => 'Stem::Log',
+ 'args' => [
+
+ 'name' => 'bar_stdout',
+ 'format' => '%f [%L][%l] %T',
+ 'strftime' => '%D %T',
+ 'filters' => [
+ 'env_gt_level' => 'bar_stdout',
+ stdout => 1,
+ ],
+ ],
+],
+[
+ 'class' => 'Stem::Log',
+ 'args' => [
+
+ 'name' => 'bar_status',
+
+ 'file' => [
+ 'path' => 'tail/bar_status.log',
+ ],
+
+ 'format' => '[%f]%h:%H:%P - %T',
+ 'strftime' => '%T',
+ 'filters' => [
+ file => 1,
+ 'env_gt_level' => 'bar_status',
+# stdout => 1,
+ console => 1,
+ ],
+ ],
+],
--- /dev/null
+[ class => 'Stem::Log',
+ args => [
+
+ name => 'stdout',
+ filters => [
+ 'stdout' => 1,
+ ],
+ ],
+],
+[
+ class => 'Stem::Boot',
+ name => 'test',
+ args => [
+ boot_file => 'test/test.boot',
+ ]
+],
--- /dev/null
+# chat.stem
+#
+[
+ class => 'Stem::Console',
+],
+[
+ class => 'Stem::SockMsg',
+ name => 'A',
+ args => [
+ port => 6666,
+ server => 1,
+ cell_attr => [
+ 'data_addr' => ':sw:a'
+ ],
+ ],
+],
+[
+ class => 'Stem::SockMsg',
+ name => 'B',
+ args => [
+ port => 6667,
+ server => 1,
+ cell_attr => [
+ 'data_addr' => ':sw:b'
+ ],
+ ],
+],
+[
+ class => 'Stem::SockMsg',
+ name => 'C',
+ args => [
+ port => 6668,
+ server => 1,
+ cell_attr => [
+ 'data_addr' => ':sw:c'
+ ],
+ ],
+],
+[
+ class => 'Stem::SockMsg',
+ name => 'D',
+ args => [
+ port => 6669,
+ server => 1,
+ cell_attr => [
+ 'data_addr' => ':sw:d'
+ ],
+ ],
+],
+[
+ class => 'Stem::Switch',
+ name => 'sw',
+ args => [
+
+ in_map => [
+
+ a => [ qw( a b c d ) ],
+ b => 'a',
+ c => [ qw( b d ) ],
+ d => 'c',
+ ],
+
+ out_map => [
+
+ a => 'A',
+ b => 'B',
+ c => 'C',
+ d => 'D',
+ ],
+ ],
+],
--- /dev/null
+# chat_client.stem
+#
+[
+ class => 'Stem::Console',
+],
+[
+ class => 'Stem::Hub',
+ name => 'client',
+ args => [],
+],
+[
+ class => 'Stem::Portal',
+ args => [],
+],
+[
+ class => 'Stem::SockMsg',
+ name => 'A',
+ args => [
+ port => 6666,
+ server => 1,
+ cell_attr => [
+ 'data_addr' => ':sw:a'
+ ],
+ ],
+],
+[
+ class => 'Stem::SockMsg',
+ name => 'B',
+ args => [
+ port => 6667,
+ server => 1,
+ cell_attr => [
+ 'data_addr' => ':sw:b'
+ ],
+ ],
+],
--- /dev/null
+# chat.stem
+#
+[
+ class => 'Stem::Console',
+],
+[
+ class => 'Stem::Demo::Cmd',
+ name => 'cmd',
+],
+[
+ class => 'Stem::SockMsg',
+ name => 'A',
+ args => [
+ port => 6666,
+ server => 1,
+ cell_attr => [
+ 'data_addr' => ':label:a'
+ ],
+ ],
+],
+[
+ class => 'Stem::SockMsg',
+ name => 'B',
+ args => [
+ port => 6667,
+ server => 1,
+ cell_attr => [
+ 'data_addr' => ':label:b'
+ ],
+ ],
+],
+[
+ class => 'Stem::SockMsg',
+ name => 'C',
+ args => [
+ port => 6668,
+ server => 1,
+ cell_attr => [
+ 'data_addr' => ':label:c'
+ ],
+ ],
+],
+[
+ class => 'Stem::SockMsg',
+ name => 'D',
+ args => [
+ port => 6669,
+ server => 1,
+ cell_attr => [
+ 'data_addr' => ':label:d'
+ ],
+ ],
+],
+[
+ class => 'Stem::ChatLabel',
+ name => 'label',
+ args => [
+ sw_addr => 'sw',
+ ],
+],
+
+
+[
+ class => 'Stem::Switch',
+ name => 'sw',
+ args => [
+
+ in_map => [
+
+ a => [ qw( a b c d ) ],
+ b => 'a',
+ c => [ qw( b d ) ],
+ d => 'c',
+ ],
+
+ out_map => [
+
+ a => 'A',
+ b => 'B',
+ c => 'C',
+ d => 'D',
+ ],
+ ],
+],
--- /dev/null
+# chat_server.stem
+#
+[
+ class => 'Stem::Console',
+],
+[
+ class => 'Stem::Hub',
+ name => 'server',
+ args => [],
+],
+[
+ class => 'Stem::Portal',
+ args => ['server' => 1 ],
+],
+[
+ class => 'Stem::SockMsg',
+ name => 'C',
+ args => [
+ port => 6668,
+ server => 1,
+ cell_attr => [
+ 'data_addr' => ':sw:c'
+ ],
+ ],
+],
+[
+ class => 'Stem::SockMsg',
+ name => 'D',
+ args => [
+ port => 6669,
+ server => 1,
+ cell_attr => [
+ 'data_addr' => ':sw:d'
+ ],
+ ],
+],
+[
+ class => 'Stem::Switch',
+ name => 'sw',
+ args => [
+
+ in_map => [
+
+ a => [ qw( a b c d ) ],
+ b => 'a',
+ c => [ qw( b d ) ],
+ d => 'c',
+ ],
+
+ out_map => [
+
+ a => 'client:A',
+ b => 'client:B',
+ c => 'C',
+ d => 'D',
+ ],
+ ],
+],
--- /dev/null
+[
+ class => 'Stem::Console',
+],
+[
+ class => 'Stem::SockMsg',
+ name => 'cli_sock',
+ args => [
+ port => 8888,
+ server => 1,
+ host => '',
+ cell_attr => [
+ 'cloneable' => 1,
+ 'data_addr' => 'cli',
+ 'codec' => 'Data::Dumper',
+ ],
+ ],
+],
+[
+ class => 'Stem::Demo::CLI',
+ name => 'cli',
+ args => [
+ cell_attr => [
+ cloneable => 1,
+ no_io => 1,
+ ],
+ ],
+],
--- /dev/null
+# cron.stem
+#
+[
+ class => 'Stem::Console',
+],
+[
+ class => 'Stem::Demo::Cmd',
+ name => 'cmd',
+],
+[
+ class => 'Stem::Cron',
+ name => 'cron',
+ args => [
+
+ 'hours' => [ 0 .. 8 ],
+ 'month_days' => [ '11-15' ],
+ 'months' => [ '12' ],
+
+ 'msg' => [
+
+ 'to_cell' => 'console',
+ 'data' => "foo\n",
+ ]
+ ],
+],
--- /dev/null
+# hello.stem
+#
+[
+ class => 'Stem::Console',
+],
+[
+ class => 'Stem::Demo::World',
+ name => 'world',
+],
--- /dev/null
+# hello_client.stem
+#
+[
+ class => 'Stem::Hub',
+ name => 'system_B',
+ args => [
+ 'host' => 'localhost',
+ ],
+],
+[
+ class => 'Stem::Portal',
+ args => [],
+],
+[
+ class => 'Stem::Proc',
+ name => 'hello',
+ args => [
+ path => 'bin/hello.sh',
+ proc_args => ['client'],
+ cell_attr => [
+ 'data_addr' => 'system_A:console',
+ ],
+ ],
+],
--- /dev/null
+# hello_server.stem
+#
+[
+ class => 'Stem::Console',
+],
+[
+ class => 'Stem::Hub',
+ name => 'system_A',
+ args => [],
+],
+[
+ class => 'Stem::Portal',
+ args => [
+ 'server' => 1,
+ 'host' => 'localhost',
+ ],
+],
+[
+ class => 'Stem::Switch',
+ name => 'sw',
+ args => [
+ in_map => [
+
+ h => [ qw( h h3 ) ],
+ ],
+ out_map => [
+
+ h => 'hello',
+ h3 => 'system_B:hello',
+ ],
+ ],
+],
+[
+ class => 'Stem::Proc',
+ name => 'hello',
+ args => [
+ path => 'bin/hello.sh',
+ proc_args => ['server'],
+ cell_attr => [
+ 'data_addr' => 'console',
+ ],
+ ],
+],
--- /dev/null
+# hello_shell.stem
+[
+ class => 'Stem::Console',
+],
+[
+ class => 'Stem::Proc',
+ name => 'hello',
+ args => [
+ path => 'bin/hello.sh',
+ cell_attr => [
+ 'data_addr' => 'console',
+ ],
+ ],
+],
--- /dev/null
+--- #YAML:1.0
+-
+ class: Stem::Console
+-
+ class: Stem::Proc
+ name: hello
+ args:
+ path: bin/hello.sh
+ proc_args:
+ - Athena Health
+ cell_attr:
+ data_addr: console
--- /dev/null
+# inetd.stem
+#
+# Emulate an inetd daemon
+#
+#
+# Load the consols module so we can enter commands to stem
+[
+ class => 'Stem::Console',
+],
+
+# these two cells are both SockMsg's. they are servers listening for
+# connections on different ports. they have different Cell addresses (A,
+# B). Both use the Stem::Cell attributes to handle cloning upon
+# connection and the logical pipe to the Stem::Proc cell. Note that B
+# has the pipe_args option which sends extra arguments to the other side
+# of the pipe. this enables line numbering in the output of the
+# proc_serv script.
+
+[
+ class => 'Stem::SockMsg',
+ name => 'A',
+ args => [
+ port => 6666,
+ server => 1,
+ cell_attr => [
+ 'cloneable' => 1,
+# this name maps to the cell name of the Stem::Proc below
+ 'pipe_addr' => 'quote',
+ ],
+ ],
+],
+[
+ class => 'Stem::SockMsg',
+ name => 'B',
+ args => [
+ port => 6667,
+ server => 1,
+ cell_attr => [
+ 'cloneable' => 1,
+# this name maps to the cell name of the Stem::Proc below
+ 'pipe_addr' => 'quote',
+ 'pipe_args' => '-n',
+ ],
+ ],
+],
+
+# this is the Stem::Proc cell actually forks the program. its name is
+# refered to by the SockMsg cells.
+
+[
+ class => 'Stem::Proc',
+ name => 'quote',
+ args => [
+ path => 'quote_serve',
+ use_stderr => 1,
+ cell_attr => [
+ 'cloneable' => 1,
+ ],
+ ],
+],
--- /dev/null
+[
+ class => 'Stem::Console',
+],
+[
+ 'class' => 'Stem::Hub',
+ 'name' => 'Load',
+ 'args' => [],
+],
+[
+ 'class' => 'Stem::Portal',
+ 'name' => 'load',
+ 'args' => [
+ 'port' => 10001,
+ ],
+],
+[
+ class => 'Stem::Load::Driver',
+ name => 'driver',
+ args => [
+ 'load_addr' => 'Echo:echo',
+ 'max_loads_per_hub' => 1,
+ 'max_load_msgs' => 100,
+ ],
+],
--- /dev/null
+[
+ class => 'Stem::Console',
+],
+[
+ class => 'Stem::Load::Driver',
+ name => 'driver',
+ args => [
+ load_addr => 'echo',
+ ],
+],
+[
+ class => 'Stem::Test::Echo',
+ name => 'echo',
+ args => [],
+],
--- /dev/null
+# monitor.stem
+#
+[
+ class => 'Stem::Console',
+],
+[
+ 'class' => 'Stem::Hub',
+ 'name' => 'monitor',
+ 'args' => [],
+],
+[
+ class => 'Stem::Portal',
+ args => [
+ ],
+],
+[
+ 'class' => 'Stem::Log::Tail',
+ 'name' => 'foo',
+ 'args' => [
+ 'path' => 'tail/foo.log',
+ 'interval' => 3,
+ 'delay' => 0,
+ 'data_log' => 'archive:bar',
+ 'status_log' => 'archive:bar_status',
+ ],
+],
--- /dev/null
+[
+ class => 'Stem::Console',
+],
+[
+ 'class' => 'Stem::Hub',
+ 'name' => 'proc',
+ 'args' => [],
+],
+
+# this portal listens for the driver hub
+[
+ 'class' => 'Stem::Portal',
+ 'name' => 'Echo',
+ 'args' => [
+ 'host' => '',
+ 'port' => 10001,
+ 'server' => 1
+ ],
+],
+[
+ class => 'Stem::Proc',
+ name => 'echo',
+ args => [
+ path => './bin/echo_worker.pl',
+ spawn_now => 1,
+ cell_attr => [
+ 'worker_mode' => 1,
+ ],
+ ],
+],
--- /dev/null
+# slave.stem
+# this is used for slave Hubs which get their configs from a master Hub
+#
+[
+ class => 'Stem::Console',
+],
+[
+ class => 'Stem::Hub',
+ name => 'slave',
+ args => [],
+],
+[
+ class => 'Stem::Portal',
+ args => [
+ 'server' => 1
+ ],
+],
--- /dev/null
+# tail.stem
+#
+[
+ 'class' => 'Stem::Console',
+],
+[
+ 'class' => 'Stem::Hub',
+ 'name' => 'tail',
+ 'args' => [],
+],
+[
+ 'class' => 'Stem::Log::Tail',
+ 'name' => 'foo',
+ 'args' => [
+ 'path' => 'tail/foo',
+ 'interval' => 5,
+ 'data_log' => 'bar',
+ 'status_log' => 'bar_status',
+ ],
+],
+[
+ 'class' => 'Stem::Log',
+ 'args' => [
+
+ 'name' => 'bar',
+ 'path' => 'tail/bar',
+ ],
+],
+[
+ 'class' => 'Stem::Log',
+ 'args' => [
+
+ 'name' => 'bar_status',
+ 'path' => 'tail/bar_status',
+
+ 'filters' => [
+ stdout => 1,
+ file => 1,
+ ],
+ ],
+],
--- /dev/null
+# test_flow.stem
+[
+ class => 'Stem::Test::Flow',
+ name => 'flow',
+ args => [],
+],
--- /dev/null
+[
+ class => 'Stem::Test::Echo',
+ name => 'echo',
+ args => [],
+],
+[
+ class => 'Stem::Test::PacketIO',
+ name => 'packet_io',
+ args => [
+ write_addr => 'client_sock',
+ ],
+],
--- /dev/null
+# test_udp.stem
+[
+ class => 'Stem::UDPMsg',
+ name => 'send_only',
+ args => [
+# send_host => 'localhost',
+ ],
+],
+[
+ class => 'Stem::UDPMsg',
+ name => 'recv_only',
+ args => [
+ bind_port => 9999,
+ bind_host => 'localhost',
+ data_addr => 'udp_test',
+ timeout_addr => 'udp_test',
+ server => 1,
+ timeout => 1,
+ ],
+],
+[
+ class => 'Stem::Test::UDP',
+ name => 'udp_test',
+ args => [
+ send_addr => 'send_only',
+ send_port => '9999',
+ ],
+],
--- /dev/null
+[
+ class => 'Stem::Console',
+],
+[
+ 'class' => 'Stem::Hub',
+ 'name' => 'tick_driver',
+ 'args' => [],
+],
+[
+ 'class' => 'Stem::Portal',
+ 'name' => 'tick_server',
+ 'args' => [
+ 'server' => 1,
+ ],
+],
+[
+ class => 'Stem::WorkQueue',
+ name => 'dbi_queue',
+ args => [],
+],
+
+
+[
+ 'class' => 'Stem::Load::Ticker',
+ 'name' => 'tick',
+ 'args' => [
+ dbi_addr => 'dbi_queue',
+ ],
+],
--- /dev/null
+# ttysock.stem
+#
+# drive this from the command line with
+# tty_host and tty_port
+[
+ class => 'Stem::TtySock',
+ args => [],
+],
--- /dev/null
+--- #YAML:1.0
+# -
+# class: Stem::Test::ConfTypes
+# name: boolean
+# args:
+# bool_attr: yes
+# -
+# class: Stem::Test::ConfTypes
+# name: scalar
+# args:
+# list_attr: scalar_val
+# -
+# class: Stem::Test::ConfTypes
+# name: list
+# args:
+# list_attr: [ list, of, three ]
+# -
+# class: Stem::Test::ConfTypes
+# name: hash_to_list
+# args:
+# list_attr:
+# hash: of
+# key: value
+# -
+# class: Stem::Test::ConfTypes
+# name: hash
+# args:
+# hash_attr:
+# foo: bar
+# -
+# class: Stem::Test::ConfTypes
+# name: list_to_hash
+# args:
+# hash_attr:
+# - foo
+# - bar
+# -
+# class: Stem::Test::ConfTypes
+# name: lol_to_lol
+# args:
+# lol_attr:
+# - [ 1, 2 ]
+# - [ 3, 4 ]
+# -
+# class: Stem::Test::ConfTypes
+# name: loh_to_lol
+# args:
+# lol_attr:
+# -
+# foo: 1
+# -
+# bar: 2
+# -
+# class: Stem::Test::ConfTypes
+# name: hol_to_lol
+# args:
+# lol_attr:
+# foo: [ 1, 2 ]
+# bar: 3
+-
+ class: Stem::Test::ConfTypes
+ name: hoh_to_lol
+ args:
+ lol_attr:
+ foo: [ 1, 2 ]
+ bar: 3
+-
+ class: Stem::Test::ConfTypes
+ name: hoh_to_hol
+ args:
+ hol_attr:
+ foo: [ 1, 2 ]
+ bar: 3
+-
+ class: Stem::Test::ConfTypes
+ name: lol_to_hol
+ args:
+ hol_attr:
+ - foo
+ - [ 1, 2 ]
+ - bar
+ - 3
+-
+ class: Stem::Test::ConfTypes
+ name: lolh_to_loh
+ args:
+ loh_attr:
+ -
+ foo: faaa
+ - [ 1, 2 ]
+ -
+ bar: jejej
+ - [ 3, 5, 4, 0 ]
+-
+ class: Stem::Test::ConfTypes
+ name: lolh_to_hol
+ args:
+ hol_attr:
+ -
+ foo: faaa
+ - [ 1, 2 ]
+ -
+ bar: jejej
+ - [ 3, 5, 4, 0 ]
--- /dev/null
+# File: Stem.pm
+
+# This file is part of Stem.
+# Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
+
+# Stem is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# Stem is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with Stem; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# For a license to use the Stem under conditions other than those
+# described here, to purchase support for this software, or to purchase a
+# commercial warranty contract, please contact Stem Systems at:
+
+# Stem Systems, Inc. 781-643-7504
+# 79 Everett St. info@stemsystems.com
+# Arlington, MA 02474
+# USA
+
+package Stem ;
+
+=head1 Stem.pm - A Network Application Toolkit and Framework
+
+This module load these core Stem modules:
+
+ Stem::Util ; # support utilities
+ Stem::Class ; # object constructor
+ Stem::Event ; # event loop
+ Stem::Msg ; # message creation and delivery
+ Stem::Route ; # message routing
+ Stem::Vars ; # stem environment
+ Stem::Conf ; # configuration file handling
+ Stem::Log ; # logging services
+
+You can create a script and just use Stem.pm (see the tests in t/ for
+some examples) but most Stem applications will use the startup script
+<B>run_stem</B> which loads this module and your configuration files.
+
+=cut
+
+
+
+use strict ;
+use vars qw( $VERSION ) ;
+
+$VERSION = 0.12 ;
+
+use Stem::Util ;
+use Stem::Class ;
+use Stem::Event ;
+use Stem::Msg ;
+use Stem::Route qw( :cell ) ;
+use Stem::Vars ;
+use Stem::Conf ;
+use Stem::Log ;
+#use Stem::Hub ;
+
+register_class( __PACKAGE__, 'stem' ) ;
+
+
+sub version_cmd {
+
+ return "Stem Version: $VERSION" ;
+}
+
+1 ;
--- /dev/null
+# File: Stem/AsyncIO.pm
+
+# This file is part of Stem.
+# Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
+
+# Stem is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# Stem is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with Stem; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# For a license to use the Stem under conditions other than those
+# described here, to purchase support for this software, or to purchase a
+# commercial warranty contract, please contact Stem Systems at:
+
+# Stem Systems, Inc. 781-643-7504
+# 79 Everett St. info@stemsystems.com
+# Arlington, MA 02474
+# USA
+
+package Stem::AsyncIO ;
+
+use strict ;
+use Data::Dumper ;
+
+use Stem::Vars ;
+
+
+my $attr_spec = [
+
+ {
+ 'name' => 'object',
+ 'required' => 1,
+ 'help' => <<HELP,
+HELP
+ },
+
+ {
+ 'name' => 'read_method',
+ 'default' => 'async_read_data',
+ 'help' => <<HELP,
+Method called with the data read from the read handle. It is only called if the
+data_addr attribute is not set.
+HELP
+ },
+
+ {
+ 'name' => 'stderr_method',
+ 'default' => 'async_stderr_data',
+ 'help' => <<HELP,
+Method called with the data read from the stderr handle. It is only
+called if the stderr_addr attribute is not set.
+HELP
+ },
+
+ {
+ 'name' => 'closed_method',
+ 'default' => 'async_closed',
+ 'help' => <<HELP,
+Method used when this object is closed.
+HELP
+ },
+ {
+ 'name' => 'fh',
+ 'help' => <<HELP,
+File handle used for reading and writing.
+HELP
+ },
+ {
+ 'name' => 'read_fh',
+ 'help' => <<HELP,
+File Handle used for reading.
+HELP
+ },
+ {
+ 'name' => 'write_fh',
+ 'help' => <<HELP,
+File handle used for standard output.
+HELP
+ },
+ {
+ 'name' => 'stderr_fh',
+ 'help' => <<HELP,
+File handle used for Standard Error.
+HELP
+ },
+ {
+ 'name' => 'data_addr',
+ 'type' => 'address',
+ 'help' => <<HELP,
+The address of the Cell where the data is sent.
+HELP
+ },
+ {
+ 'name' => 'stderr_addr',
+ 'type' => 'address',
+ 'help' => <<HELP,
+The address of the Cell where the stderr is sent.
+HELP
+ },
+ {
+ 'name' => 'data_msg_type',
+ 'default' => 'data',
+ 'help' => <<HELP,
+This sets the type of the data message.
+HELP
+ },
+ {
+ 'name' => 'codec',
+ 'help' => <<HELP,
+Use this codec to encode/decode the I/O data. Each write is encoded to
+one packet out. Each packet read in will be decoded and either send a
+data message or generate a callback.
+HELP
+ },
+ {
+ 'name' => 'stderr_msg_type',
+ 'default' => 'stderr_data',
+ 'help' => <<HELP,
+This sets the type of the stderr data message.
+HELP
+ },
+ {
+ 'name' => 'from_addr',
+ 'type' => 'address',
+ 'help' => <<HELP,
+The address used in the 'from' field of data and stderr messages.
+HELP
+ },
+ {
+ 'name' => 'send_data_on_close',
+ 'type' => 'boolean',
+ 'help' => <<HELP,
+Buffer all read data and send it when the read handle is closed.
+HELP
+ },
+ {
+ 'name' => 'id',
+ 'help' => <<HELP,
+The id is passed to the callback method as its only argument. Use it to
+identify different instances of this object.
+HELP
+
+ },
+
+################
+## add support to log all AIO
+################
+
+ {
+ 'name' => 'log_label',
+ 'default' => 'AIO',
+ 'help' => <<HELP,
+HELP
+ },
+ {
+ 'name' => 'log_level',
+ 'default' => 5,
+ 'help' => <<HELP,
+HELP
+ },
+ {
+ 'name' => 'read_log',
+ 'help' => <<HELP,
+HELP
+ },
+
+ {
+ 'name' => 'stderr_log',
+ 'help' => <<HELP,
+HELP
+ },
+
+ {
+ 'name' => 'write_log',
+ 'help' => <<HELP,
+HELP
+ },
+
+
+] ;
+
+use Carp 'cluck' ;
+
+sub new {
+
+ my( $class ) = shift ;
+
+ my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
+ return $self unless ref $self ;
+
+#cluck "NEW $self" ;
+
+ if ( $self->{'data_addr'} && ! $self->{'from_addr'} ) {
+
+ return "Using 'data_addr in AsyncIO requires a 'from_addr'" ;
+ }
+
+ if ( my $codec = $self->{'codec'} ) {
+
+ require Stem::Packet ;
+ my $packet = Stem::Packet->new( 'codec' => $codec ) ;
+ return $packet unless ref $packet ;
+
+ $self->{'packet'} = $packet ;
+ }
+
+ $self->{'stderr_addr'} ||= $self->{'data_addr'} ;
+
+ $self->{'buffer'} = '' if $self->{'send_data_on_close'} ;
+
+ $self->{ 'read_fh' } ||= $self->{ 'fh' } ;
+ $self->{ 'write_fh' } ||= $self->{ 'fh' } ;
+
+ if ( my $read_fh = $self->{'read_fh'} ) {
+
+ my $read_event = Stem::Event::Read->new(
+ 'object' => $self,
+ 'fh' => $read_fh,
+ ) ;
+
+ return $read_event unless ref $read_event ;
+
+ $self->{'read_event'} = $read_event ;
+ }
+
+ if ( my $stderr_fh = $self->{'stderr_fh'} ) {
+
+ my $stderr_event = Stem::Event::Read->new(
+ 'object' => $self,
+ 'fh' => $stderr_fh,
+ 'method' => 'stderr_readable',
+ ) ;
+
+ return $stderr_event unless ref $stderr_event ;
+
+ $self->{'stderr_event'} = $stderr_event ;
+ }
+
+ if ( my $write_fh = $self->{'write_fh'} ) {
+
+ my $write_event = Stem::Event::Write->new(
+ 'object' => $self,
+ 'fh' => $write_fh,
+ ) ;
+
+ return $write_event unless ref $write_event ;
+
+ $self->{'write_event'} = $write_event ;
+
+ $self->{'write_buf'} = '' ;
+ }
+
+ return $self ;
+}
+
+sub shut_down {
+
+ my( $self ) = @_ ;
+
+#cluck "SHUT $self\n" ;
+
+
+ if ( $self->{'shut_down'} ) {
+
+ return ;
+ }
+
+ $self->{'shutting_down'} = 1 ;
+
+ $self->read_shut_down() ;
+
+ $self->write_shut_down() ;
+
+ if ( my $event = delete $self->{'stderr_event'} ) {
+
+ $event->cancel() ;
+ close( $self->{'stderr_fh'} ) ;
+ }
+
+ $self->{'shut_down'} = 1 ;
+
+#print "DELETE OBJ", caller(), "\n" ;
+
+ delete $self->{'object'} ;
+}
+
+sub read_shut_down {
+
+ my( $self ) = @_ ;
+
+ if ( my $event = delete $self->{'read_event'} ) {
+
+ $event->cancel() ;
+ }
+
+ shutdown( $self->{'read_fh'}, 0 ) ;
+}
+
+sub write_shut_down {
+
+ my( $self ) = @_ ;
+
+ if ( exists( $self->{'write_buf'} ) &&
+ length( $self->{'write_buf'} ) ) {
+
+#print "write handle shut when empty\n" ;
+ $self->{'shut_down_when_empty'} = 1 ;
+
+ return ;
+ }
+
+ if ( my $event = delete $self->{'write_event'} ) {
+
+ shutdown( $self->{'write_fh'}, 1 ) ;
+ $event->cancel() ;
+ }
+}
+
+sub readable {
+
+ my( $self ) = @_ ;
+
+ my( $read_buf ) ;
+
+ return if $self->{'shut_down'} ;
+
+ my $bytes_read = sysread( $self->{'read_fh'}, $read_buf, 8192 ) ;
+
+#print "READ: $bytes_read [$read_buf]\n" ;
+
+ unless( defined( $bytes_read ) && $bytes_read > 0 ) {
+
+ $self->read_shut_down() ;
+
+ if ( $self->{'send_data_on_close'} &&
+ length( $self->{'buffer'} ) ) {
+
+ $self->send_data() ;
+
+# since we sent the total read buffer, we don't do a closed callback.
+
+ return ;
+ }
+
+ $self->_callback( 'closed_method' ) ;
+
+ return ;
+ }
+
+# decode the packet if needed
+
+ if ( my $packet = $self->{packet} ) {
+
+ my $buf_ref = \$read_buf ;
+
+ while( my $data_ref = $packet->to_data( $buf_ref ) ) {
+
+ $self->send_data( $data_ref ) ;
+ $buf_ref = undef ;
+ }
+
+ return ;
+ }
+
+ if ( $self->{'send_data_on_close'} ) {
+
+ $self->{'buffer'} .= $read_buf ;
+ return ;
+ }
+
+ $self->send_data( \$read_buf ) ;
+}
+
+sub send_data {
+
+ my( $self, $buffer ) = @_ ;
+
+ my $buf_ref = $buffer || \$self->{'buffer'} ;
+
+ $self->_send_data_msg( 'data_addr', 'data_msg_type', $buf_ref ) ;
+ $self->_callback( 'read_method', $buf_ref ) ;
+
+ return ;
+}
+
+sub stderr_readable {
+
+ my( $self ) = @_ ;
+
+ my( $read_buf ) ;
+
+ my $bytes_read = sysread( $self->{'stderr_fh'}, $read_buf, 8192 ) ;
+
+# no callback on stderr close. let the read handle close deal with the
+# shutdown
+
+ return if $bytes_read == 0 ;
+
+#print "STDERR READ [$read_buf]\n" ;
+
+ $self->_send_data_msg( 'stderr_addr', 'stderr_msg_type', \$read_buf ) ;
+ $self->_callback( 'stderr_method', \$read_buf ) ;
+}
+
+sub _send_data_msg {
+
+ my( $self, $addr_attr, $type_attr, $data_ref ) = @_ ;
+
+ my $to_addr = $self->{$addr_attr} or return ;
+
+ my $msg = Stem::Msg->new(
+ 'to' => $to_addr,
+ 'from' => $self->{'from_addr'},
+ 'type' => $self->{$type_attr},
+ 'data' => $data_ref,
+ ) ;
+
+#print $msg->dump( 'SEND DATA' ) ;
+ $msg->dispatch() ;
+}
+
+sub _callback {
+
+ my ( $self, $method_attr, @data ) = @_ ;
+
+ my $obj = $self->{'object'} or return ;
+
+ my $method = $self->{$method_attr} ;
+
+ my $code = $obj->can( $method ) or return ;
+
+ return $obj->$code( @data, $self->{'id'} ) ;
+}
+
+sub write {
+
+ my( $self ) = shift ;
+
+ return unless @_ ;
+
+ return unless exists( $self->{'write_buf'} ) ;
+
+ my $buffer = shift ;
+
+ return if $self->{'shut_down'} ;
+
+# encode the data in a packet if needed
+
+ if ( my $packet = $self->{packet} ) {
+
+ my $buf_ref = $packet->to_packet( $buffer ) ;
+
+ $self->{'write_buf'} .= ${$buf_ref} ;
+ }
+ else {
+
+ $self->{'write_buf'} .= ref $buffer eq 'SCALAR' ?
+ ${$buffer} : $buffer ;
+ }
+
+ $self->{'write_event'}->start() ;
+}
+
+sub final_write {
+
+ my( $self ) = @_ ;
+
+ $self->write( $_[1] ) ;
+
+ $self->write_shut_down() ;
+}
+
+
+sub writeable {
+
+ my( $self ) = @_ ;
+
+ return if $self->{'shut_down'} ;
+
+ my $buf_ref = \$self->{'write_buf'} ;
+ my $buf_len = length $$buf_ref ;
+
+#print "BUFLEN [$buf_len]\n" ;
+
+ unless ( $buf_len ) {
+
+#print "AIO W STOPPING\n" ;
+ $self->{'write_event'}->stop() ;
+ return ;
+ }
+
+ my $bytes_written = syswrite( $self->{'write_fh'}, $$buf_ref ) ;
+
+ unless( defined( $bytes_written ) ) {
+
+# do a SHUTDOWN
+ return ;
+ }
+
+# remove the part of the buffer that was written
+
+ substr( $$buf_ref, 0, $bytes_written, '' ) ;
+
+ return if length( $$buf_ref ) ;
+
+ $self->write_shut_down() if $self->{'shut_down_when_empty'} ;
+}
+
+
+# DESTROY {
+
+# my( $self ) = @_ ;
+
+# print "DESTROY $self\n" ;
+
+# }
+
+1 ;
--- /dev/null
+# File: Stem/Boot.pm
+
+# This file is part of Stem.
+# Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
+
+# Stem is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# Stem is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with Stem; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# For a license to use the Stem under conditions other than those
+# described here, to purchase support for this software, or to purchase a
+# commercial warranty contract, please contact Stem Systems at:
+
+# Stem Systems, Inc. 781-643-7504
+# 79 Everett St. info@stemsystems.com
+# Arlington, MA 02474
+# USA
+
+package Stem::Boot ;
+
+use strict ;
+use Carp ;
+use Symbol ;
+
+my $attr_spec = [
+
+ {
+ 'name' => 'reg_name',
+ 'help' => <<HELP,
+This is the name under which this Cell was registered.
+HELP
+ },
+ {
+ 'name' => 'boot_file',
+ 'required' => 1,
+ 'help' => <<HELP,
+This is the file that describes the processes to bootstrap
+HELP
+ },
+ {
+ 'name' => 'name',
+ 'help' => <<HELP,
+Name of this boot entry
+HELP
+ },
+ {
+ 'name' => 'cmd',
+ 'help' => <<HELP,
+Path to command that will be booted
+HELP
+ },
+ {
+ 'name' => 'log',
+ 'help' => <<HELP,
+Default Name of logical log to send all status and process output
+HELP
+ },
+ {
+ 'name' => 'delay',
+ 'help' => <<HELP,
+Default delay (in seconds) between spawning processes
+HELP
+ },
+ {
+ 'name' => 'user',
+ 'help' => <<HELP,
+Default user id to run the processes
+HELP
+ },
+ {
+ 'name' => 'wrap',
+ 'default' => '/bin/sh -c',
+ 'help' => <<HELP,
+Default command wrapper for each process
+HELP
+ },
+ {
+ 'name' => 'chdir',
+ 'help' => <<HELP,
+Default dir to chdir to before running each process
+HELP
+ },
+ {
+ 'name' => 'boot_now',
+ 'type' => 'boolean',
+ 'default' => 1,
+ 'help' => <<HELP,
+Boot this program when this object is created
+HELP
+ },
+ {
+ 'name' => 'restart',
+ 'help' => <<HELP,
+Restart this program when it exits
+HELP
+ },
+] ;
+
+my %name2boot ;
+
+
+sub new {
+
+ my( $class ) = shift ;
+
+ my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
+ return $self unless ref $self ;
+
+ my $boot_info = Stem::Util::load_file( $self->{'boot_file'} ) ;
+ return $boot_info unless ref $boot_info ;
+
+ foreach my $boot ( @{$boot_info} ) {
+
+ die "boot entry is not a hash\n" unless ref $boot eq 'HASH' ;
+
+ if ( my $skip = $boot->{'skip'} ) {
+
+ next if lc $skip eq 'yes' ;
+ }
+
+ my $boot_obj = Stem::Class::parse_args( $attr_spec,
+ %{$self},
+ %{$boot}
+ ) ;
+
+ die "boot entry error: $boot_obj\n" unless ref $boot_obj ;
+
+ my $cmd = $boot_obj->{'cmd'} ;
+ die "boot entry is missing 'cmd'\n" unless $cmd ;
+
+ my $name = $boot_obj->{'name'} ;
+ die "boot entry is missing 'name'\n" unless $name ;
+
+ $name2boot{ $name } = $boot_obj ;
+
+ if ( $boot_obj->{'boot_now'} ) {
+
+ $boot_obj->run_cmd() ;
+ }
+ }
+
+ return ;
+}
+
+
+sub run_cmd {
+
+ my( $self ) = @_ ;
+
+#print Store $self ;
+
+ my $cmd ;
+
+ if ( my $user = $self->{'user'} ) {
+
+ if ( getpwuid($<) ne $user ) {
+
+ $cmd .= "su - $user ; " ;
+ }
+ }
+
+ if ( my $wrap = $self->{'wrap'} ) {
+
+ $cmd .= qq{$wrap "} ;
+ $self->{'wrap_end'} ||= '"' ;
+ }
+
+ if ( my $chdir = $self->{'chdir'} ) {
+
+ $cmd .= "cd $chdir ; " ;
+ }
+
+ if ( my $stem_env = $self->{'stem_env'} ) {
+
+ my $cmd_env = join ' ', map(
+ "$_='$stem_env->{$_}'", keys %{$stem_env} ) ;
+
+ $cmd =~ s/run_stem/run_stem $cmd_env/ ;
+ }
+
+ $cmd .= $self->{'cmd'} ;
+
+ $cmd .= $self->{'wrap_end'} if $self->{'wrap_end'} ;
+
+ my $handle = gensym ;
+
+#print "$cmd\n" ;
+
+ if ( my $pid = open( $handle, '-|' ) ) {
+
+#print "pid $pid\n" ;
+ $self->{'pid'} = $pid ;
+ $self->{'handle'} = $handle ;
+ }
+ elsif ( defined( $pid ) ) {
+
+ local( %ENV ) = ( %ENV, %{ $self->{'env'} || {} } ) ;
+
+ open( STDERR, '>&STDOUT' ) ;
+
+ exec $cmd ;
+ die "Couldn't exec [$cmd]\n" ;
+ }
+ else {
+
+ die "couldn't fork\n" ;
+ }
+
+ my $aio = Stem::AsyncIO->new(
+
+ 'object' => $self,
+ 'read_fh' => $handle,
+ 'read_method' => 'boot_read',
+ 'closed_method' => 'boot_closed',
+ ) ;
+
+ $self->{'aio'} = $aio ;
+
+ if ( my $log = $self->{'log'} ) {
+
+ Stem::Log::Entry->new(
+ 'logs' => $log,
+ 'label' => 'boot',
+ 'text' =>
+ "Booting $self->{'name'} PID = $self->{'pid'}: $cmd\n",
+ ) ;
+ }
+
+ return ;
+}
+
+sub boot_read {
+
+ my( $self, $data ) = @_ ;
+
+#print "BOOT READ [$$data]\n" ;
+
+ if ( my $log = $self->{'log'} ) {
+
+ Stem::Log::Entry->new(
+ 'logs' => $log,
+ 'label' => 'boot',
+ 'text' => "Output for $self->{'name'}\n[${$data}]\n",
+ ) ;
+ }
+
+ return ;
+}
+
+sub boot_closed {
+
+ my( $self ) = @_ ;
+
+#print "BOOT closed\n" ;
+
+ $self->{'aio'}->shut_down() ;
+ delete $self->{'aio'} ;
+
+ my $boot_pid = $self->{'pid'} ;
+ my $pid = waitpid( $boot_pid, 0 ) ;
+
+#print "WAIT [$pid]\n" ;
+
+ if ( my $log = $self->{'log'} ) {
+
+ Stem::Log::Entry->new(
+ 'logs' => $log,
+ 'label' => 'boot',
+ 'text' => "Boot $self->{'name'} exited PID = $pid",
+ ) ;
+ }
+
+# do restart if needed
+
+
+
+
+ return ;
+}
+
+1 ;
--- /dev/null
+# File: Stem/Cell.pm
+
+# This file is part of Stem.
+# Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
+
+# Stem is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# Stem is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with Stem; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# For a license to use the Stem under conditions other than those
+# described here, to purchase support for this software, or to purchase a
+# commercial warranty contract, please contact Stem Systems at:
+
+# Stem Systems, Inc. 781-643-7504
+# 79 Everett St. info@stemsystems.com
+# Arlington, MA 02474
+# USA
+
+package Stem::Cell ;
+
+use strict ;
+
+use Data::Dumper ;
+use Carp qw( cluck ) ;
+
+use Stem::Route qw( :cell ) ;
+use Stem::AsyncIO ;
+use Stem::Id ;
+use Stem::Gather ;
+use Stem::Cell::Clone ;
+use Stem::Cell::Pipe ;
+use Stem::Cell::Flow ;
+use Stem::Cell::Work ;
+
+use Stem::Trace 'log' => 'stem_status' , 'sub' => 'TraceStatus' ;
+
+my %class_to_attr_name ;
+
+my $attr_spec = [
+
+ {
+ 'name' => 'reg_name',
+ 'help' => <<HELP,
+The registered address of the owner Cell
+HELP
+ },
+ {
+ 'name' => 'cloneable',
+ 'type' => 'boolean',
+ 'help' => <<HELP,
+The parent Cell will be cloned upon triggering
+HELP
+ },
+ {
+ 'name' => 'data_addr',
+ 'type' => 'address',
+ 'help' => <<HELP,
+Cell address to send any data read in. If not set here it must come
+from a trigger message.
+HELP
+ },
+ {
+ 'name' => 'status_addr',
+ 'type' => 'address',
+ 'help' => <<HELP,
+Cell address to send Cell status to
+HELP
+ },
+ {
+ 'name' => 'send_data_on_close',
+ 'type' => 'boolean',
+ 'help' => <<HELP,
+Buffer all read data and only send it when the I/O is closed
+HELP
+ },
+ {
+ 'name' => 'no_io',
+ 'type' => 'boolean',
+ 'help' => <<HELP,
+Don't do any I/O for the Cell. Either there is none or the owner Cell must
+do its own I/O
+HELP
+ },
+ {
+ 'name' => 'pipe_addr',
+ 'type' => 'address',
+ 'help' => <<HELP,
+Cell address to open a pipe to
+HELP
+ },
+ {
+ 'name' => 'pipe_args',
+ 'help' => <<HELP,
+This is list of arguments or a single argument which is passed to the
+cell at the remote end of the pipe.
+HELP
+ },
+ {
+ 'name' => 'aio_args',
+ 'type' => 'hash',
+ 'help' => <<HELP,
+This is a list of arguments passed to the Stem::AsyncIO module constructor
+HELP
+ },
+ {
+ 'name' => 'errors_to_output',
+ 'env' => 'errors_to_output',
+ 'help' => <<HELP,
+Any received error messages will be sent to the output.
+HELP
+ },
+
+############
+# change this to max_clones
+############
+ {
+ 'name' => 'id_size',
+ 'default' => 3,
+ 'help' => <<HELP,
+Size of unique ID space for clones. Range is 26**N
+HELP
+ },
+ {
+ 'name' => 'trigger_method',
+ 'default' => 'triggered_cell',
+ 'help' => <<HELP,
+Method to callback in owner object when cell is triggered
+HELP
+ },
+
+# the below attributes are not permanent yet
+# unused so far.
+ {
+ 'name' => 'shut_down_method',
+ 'default' => 'shut_down_cell',
+ 'help' => <<HELP,
+Method to callback in owner object when cell is shutdown
+HELP
+ },
+ {
+ 'name' => 'activated_method',
+ 'default' => 'activate_cell',
+ 'help' => <<HELP,
+Method to call in owner Cell when the cell is activated. UNSUPPORTED
+HELP
+ },
+ {
+ 'name' => 'sequence_done_method',
+ 'help' => <<HELP,
+Method to call in owner Cell when the executing sequence completes.
+HELP
+ },
+ {
+ 'name' => 'codec',
+ 'help' => <<HELP,
+This sets the codec that converts data packets to/from a byte stream.
+HELP
+ },
+ {
+ 'name' => 'work_ready_addr',
+ 'type' => 'address',
+ 'help' => <<HELP,
+This is the address of the Cell that this Cell sends a message to
+when work can be done (i.e. a work message can now be sent here).
+HELP
+ },
+ {
+ 'name' => 'stderr_log',
+ 'help' => <<HELP,
+This sets the log that will get the stderr output of the process
+HELP
+ },
+] ;
+
+
+sub new {
+
+ my( $class ) = shift ;
+
+ my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
+ return $self unless ref $self ;
+
+#print $self->_dump( 'NEW' ) ;
+
+ return( $self ) ;
+}
+
+# this is only called in Stem::Conf for this class.
+# it initializes the cell info object inside its owner object.
+
+sub cell_init {
+
+ my( $self, $owner_obj, $cell_name, $cell_info_attr ) = @_ ;
+
+# the $owner_obj is the cell that owns this Stem::Cell object
+
+ $self->{'owner_obj'} = $owner_obj ;
+ $self->{'cell_name'} = $cell_name ;
+# $self->{'from_addr'} = $cell_name ;
+
+ $self->{'from_addr'} = Stem::Msg::make_address_string(
+ $Stem::Vars::Hub_name,
+ $cell_name
+ ) ;
+
+ $self->{'cell_info_attr'} = $cell_info_attr ;
+
+# save the attribute name that the owner class uses for the cell info.
+# this is how a cell info object can be found given an owner cell object.
+# also keep this name in the info itself
+
+#print "OWNER [$owner_obj]\n" ;
+ $class_to_attr_name{ ref $owner_obj } ||= $cell_info_attr ;
+
+ if ( $self->{'cloneable'} ) {
+
+ $self->{'id_obj'} = Stem::Id->new(
+ 'size' => $self->{'id_size'} ) ;
+ $self->{'is_parent'} = 1 ;
+ $self->{'target'} = '' ;
+ }
+}
+
+# get the cell info whether we were called from the owner object or
+# the cell info itself ;
+
+sub _get_cell_info {
+
+ my ( $self ) = @_ ;
+
+ my $class = ref $self ;
+
+ return "can't get cell info from '$self'\n" unless $class ;
+
+ return $self if $class eq __PACKAGE__ ;
+
+#print "CLASS [$class][$class_to_attr_name{ $class }]\n" ;
+
+ return $self->{ $class_to_attr_name{ $class } } ;
+}
+
+sub cell_trigger {
+
+ my ( $self, @args ) = @_ ;
+
+ my $self_info = $self->_get_cell_info() ;
+
+ return $self_info unless ref $self_info ;
+
+ return if $self_info->{'triggered'} ;
+
+# clone this cell and its info if needed
+# $cell will either be $self or a clone of $self
+
+ my $cell = $self_info->_clone() ;
+
+ my $cell_info = $cell->_get_cell_info() ;
+
+ $cell_info->{'triggered'} = 1 ;
+
+#print $cell_info->_dump( 'TRIGGER' ) ;
+
+# set any args (e.g. from trigger message) into this cell
+
+ $cell_info->cell_set_args( @args ) ;
+
+ $cell_info->_cell_pipe() ;
+
+ if ( my $err = $cell_info->_gather_io_args() ) {
+ $cell_info->cell_shut_down( $err ) ;
+ return $err ;
+ }
+
+# do the callback into the (possibly cloned) cell
+
+ if ( my $err = $cell_info->_callback( 'trigger_method' ) ) {
+
+#print "CALLBACK $err\n" ;
+
+ $cell_info->cell_shut_down( $err ) ;
+ return $err ;
+ }
+
+# return $cell_info ;
+ return ;
+}
+
+sub cell_trigger_cmd {
+
+ my ( $self, $msg ) = @_ ;
+
+ my @args ;
+
+ if ( my $data = $msg->data() ) {
+
+ $data = ${$data} if ref $data eq 'SCALAR' ;
+
+ my $ref = ref $data ;
+
+ if ( ! $ref && defined $data ) {
+
+ unless ( @args = $data =~ /(\S+)=(\S+)/g ) {
+
+ @args = ( 'args' => $data ) ;
+ }
+ }
+ elsif ( $ref eq 'HASH' ) {
+
+ @args = %{$data} ;
+ }
+ elsif ( $ref eq 'ARRAY' ) {
+
+ @args = @{$data} ;
+ }
+ }
+
+ push( @args, triggering_msg => $msg ) ;
+
+ my $err = $self->cell_trigger( @args ) ;
+
+print "TRIG ERR [$err]\n" if $err ;
+
+ return $err if ref $err ;
+ return ;
+}
+
+
+sub cell_shut_down {
+
+ my( $self, $error ) = @_ ;
+
+ my $cell_info = $self->_get_cell_info() ;
+
+#cluck "CELL SHUT\n" ;
+
+#print $cell_info->_dump( 'SHUT' ) ;
+
+
+ return unless $error || $cell_info->{'active'} ;
+
+ $cell_info->{'error'} = $error ;
+
+#print $cell_info->_dump( "SHUT $error" ) ;
+
+ if ( my $aio = delete $cell_info->{'aio'} ) {
+
+ $aio->shut_down() ;
+ }
+
+ if ( my $gather = delete $cell_info->{'gather'} ) {
+
+ $gather->shut_down() ;
+ }
+
+ $cell_info->_close_pipe() ;
+
+ $cell_info->_clone_delete() ;
+
+ delete $cell_info->{'args'} ;
+# delete $cell_info->{'data_addr'} ;
+
+ $cell_info->{'active'} = 0 ;
+ $cell_info->{'triggered'} = 0 ;
+
+ TraceStatus "cell shut down done" ;
+
+ return ;
+}
+
+
+sub cell_set_args {
+
+ my( $self, %args ) = @_ ;
+
+ my $cell_info = $self->_get_cell_info() ;
+
+ @{$cell_info->{'args'}}{ keys %args } = values %args ;
+
+ if ( my $gather = $cell_info->{'gather'} ) {
+
+ my $err = $gather->gathered( keys %args ) ;
+ return $err if $err ;
+ }
+
+ return ;
+}
+
+sub cell_get_args {
+
+ my( $self, @arg_keys ) = @_ ;
+
+ my $cell_info = $self->_get_cell_info() ;
+
+ return( @{$cell_info->{'args'}}{@arg_keys } ) ;
+}
+
+sub cell_info {
+
+ my( $self ) = shift ;
+
+ my $cell_info = $self->_get_cell_info() ;
+
+ $cell_info->{'info'} = shift if @_ ;
+
+ return $cell_info->{'info'} ;
+}
+
+sub _gather_io_args {
+
+ my( $self ) = @_ ;
+
+ my $cell_info = $self->_get_cell_info() ;
+
+ return if $cell_info->{'no_io'} ;
+
+ my @gather_keys = 'aio_args' ;
+
+ push( @gather_keys, 'data_addr' ) if
+ $cell_info->{'piped'} &&
+ ! $cell_info->{'data_addr'} ;
+
+ my $gather = Stem::Gather->new(
+ 'object' => $cell_info,
+ 'keys' => \@gather_keys,
+ 'gathered_method' => '_cell_activate_io',
+ ) ;
+
+ return $gather unless ref $gather ;
+
+ $cell_info->{'gather'} = $gather ;
+
+ my $err = $gather->gathered( keys %{$cell_info->{'args'}} ) ;
+
+ return $err if $err ;
+}
+
+sub _cell_activate_io {
+
+ my ( $self ) = @_ ;
+
+ TraceStatus "cell activated" ;
+
+ $self->{'active'} = 1 ;
+
+#print $self->_dump( "BEFORE AIO" ) ;
+
+ my @aio_args ;
+
+# get any config args
+
+ if ( my $aio_args = $self->{'aio_args'} ) {
+
+ push( @aio_args, %{$aio_args} ) ;
+ }
+
+# args from a trigger message override any config args
+
+ if ( my $msg_aio_args = $self->{'args'}{'aio_args'} ) {
+
+ ref $msg_aio_args eq 'ARRAY' or return <<ERR ;
+aio_args is not an ARRAY ref
+ERR
+ push( @aio_args, @{$msg_aio_args} ) ;
+ }
+
+ my $data_addr = $self->{'args'}{'data_addr'} || $self->{'data_addr'} ;
+
+ my $aio = Stem::AsyncIO->new(
+
+ 'object' => $self->{'owner_obj'},
+ 'data_addr' => $data_addr,
+ 'from_addr' => $self->{'from_addr'},
+ 'send_data_on_close' => $self->{'send_data_on_close'},
+ 'codec' => $self->{'codec'},
+ @aio_args,
+ ) ;
+
+print "AIO ERR [$aio]\n" unless ref $aio ;
+ return $aio unless ref $aio ;
+
+ $self->{'aio'} = $aio ;
+
+#print $self->_dump( "AFTER AIO" ) ;
+
+ return ;
+}
+
+sub cell_activate {
+
+ my( $self ) = @_ ;
+
+ my $cell_info = $self->_get_cell_info() ;
+
+ $cell_info->{'active'} = 1 ;
+}
+
+*cell_status_cmd = \&status_cmd ;
+
+sub status_cmd {
+
+ my( $self ) = @_ ;
+
+ my $cell_info = $self->_get_cell_info() ;
+
+ my $info = $cell_info->{'info'} || $cell_info->{'args'}{'info'} || '' ;
+
+ $info =~ s/^/\t\t/mg ;
+
+ my $class = ref $cell_info->{'owner_obj'} ;
+
+# my $data_addr = Stem::Msg::address_string(
+ my $data_addr = $cell_info->{'data_addr'} ||
+ $cell_info->{'args'}{'data_addr'} ||
+ '[NONE]' ;
+
+ my $active = ( $cell_info->{'active'} ) ? 'Active' : 'Inactive' ;
+
+ my $codec = $cell_info->{codec} || 'NONE' ;
+
+print "CELL STATUS\n" ;
+
+#my $dump = $cell_info->_dump( 'STATUS' ) ;
+my $dump = '' ;
+
+ return <<STATUS ;
+Cell Status for:
+Class: $class
+Addr: $cell_info->{'from_addr'}
+Status: $active
+Data Addr: $data_addr
+Codec: $codec
+Info:$info
+
+SELF: $self
+CELL: $cell_info
+AIO: $cell_info->{aio}
+FH: $cell_info->{fh}
+
+$dump
+
+STATUS
+
+}
+
+sub data_in {
+
+ my( $self, $msg ) = @_ ;
+
+#print "DATA SELF $self\n" ;
+
+#print $msg->dump( 'CELL IN' ) ;
+
+ my $cell_info = $self->_get_cell_info() ;
+
+ if ( $cell_info->{'is_parent'} ) {
+
+#print "PARENT\n" ;
+ TraceStatus "parent cell $cell_info->{'from_addr'} ignoring msg" ;
+
+ return ;
+ }
+
+ unless( $cell_info->{'active'} ) {
+#print "INACTIVE\n" ;
+
+ TraceStatus "cell not active. msg ignored FOO" ;
+
+ return ;
+ }
+
+#print $cell_info->_dump( "DATA IN" ) ;
+
+ $cell_info->{data_in_msg} = $msg ;
+ $cell_info->cell_write( $msg->data() ) ;
+}
+
+sub cell_write {
+
+ my( $self, $data ) = @_ ;
+
+ my $cell_info = $self->_get_cell_info() ;
+
+ $cell_info->{'aio'}->write( $data ) ;
+}
+
+sub _cell_write_sync {
+
+ my( $self, $data ) = @_ ;
+
+ my $cell_info = $self->_get_cell_info() ;
+
+#print "SYNC $$data\n" ;
+
+#print $cell_info->_dump( 'SYNC' ) ;
+
+ if ( my $aio_args = $cell_info->{'args'}{'aio_args'} ) {
+
+ my %aio_args = @{$aio_args} ;
+
+ if ( my $fh = $aio_args{'fh'} ) {
+
+# $fh->blocking( 1 ) ;
+
+ $fh->syswrite( (ref $data) ? $$data : $data ) ;
+ }
+ }
+}
+
+# handle stderr data as plain data
+
+*stderr_data_in = \&data_in ;
+
+
+# $cell_info is the Stem::Cell object of the parent cell. the name is
+# not self as it is differentiated from $clone_info.
+
+
+
+sub _callback {
+
+ my ( $self, $method_name, @data ) = @_ ;
+
+ my $method = $self->{$method_name} ;
+
+ my $owner_obj = $self->{'owner_obj'} ;
+
+ if ( $owner_obj->can( $method ) ) {
+
+ return $owner_obj->$method( @data ) ;
+ }
+
+ TraceStatus "can't call $method in $owner_obj" ;
+
+ return ;
+}
+
+sub cell_from_addr {
+
+ my ( $self ) = @_ ;
+
+ my $cell_info = $self->_get_cell_info() ;
+
+ return( $cell_info->{'from_addr'} ) ;
+}
+
+use Stem::Debug qw( dump_data ) ;
+
+sub _dump {
+
+ my ( $self, $text ) = @_ ;
+
+return $text . dump_data( $self ) ;
+
+ $text ||= 'CELL' ;
+
+ my $dump = "$text =\n" ;
+
+ my $cell_info = $self->_get_cell_info() ;
+
+# my $owner_obj = $cell_info->{owner_obj} ;
+# my @names = lookup_cell_name( $owner_obj ) ;
+# $dump .= "\nNames: @names\n" ;
+
+ foreach my $key ( sort keys %{$cell_info} ) {
+
+ my $val = $cell_info->{$key} ;
+ next unless defined $val ;
+
+ if ( $key eq 'args' ) {
+
+ $dump .= "\targs = {\n" ;
+
+ foreach my $arg ( sort keys %{$val} ) {
+
+ my $arg_val = $val->{$arg} || '';
+
+ $dump .= "\t\t$arg = '$arg_val'\n" ;
+ }
+
+ $dump .= "\t}\n" ;
+
+ next ;
+ }
+
+ $dump .= "\t$key = '$val'\n" ;
+ }
+
+ $dump .= "\n\n" ;
+
+ return $dump ;
+}
+
+sub dump_cmd {
+
+ my ($self) = @_ ;
+
+ my $cell_info = $self->_get_cell_info() ;
+
+ return $cell_info->_dump() . Dumper $cell_info ;
+}
+
+1 ;
--- /dev/null
+# File: Stem/Cell/Clone.pm
+
+# This file is part of Stem.
+# Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
+
+# Stem is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# Stem is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with Stem; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# For a license to use the Stem under conditions other than those
+# described here, to purchase support for this software, or to purchase a
+# commercial warranty contract, please contact Stem Systems at:
+
+# Stem Systems, Inc. 781-643-7504
+# 79 Everett St. info@stemsystems.com
+# Arlington, MA 02474
+# USA
+
+package Stem::Cell ;
+
+use strict ;
+
+sub cell_cloneable {
+
+ my( $self ) = @_ ;
+
+ my $cell_info = $self->_get_cell_info() ;
+
+ return $cell_info->{'cloneable'} ;
+}
+
+#####################
+#####################
+# add check of max clone count
+#####################
+#####################
+
+my @clone_fields = qw(
+
+ no_io
+ data_addr
+ errors_to_output
+ pipe_addr
+ pipe_args
+ codec
+ work_ready_addr
+ trigger_method
+ sequence_done_method
+ send_data_on_close
+ stderr_log
+) ;
+
+sub _clone {
+
+ my( $cell_info ) = @_ ;
+
+ my $owner_obj = $cell_info->{'owner_obj'} ;
+
+ return $owner_obj unless $cell_info->{'cloneable'} ;
+
+# copy the object
+
+ my $clone = bless { %{$owner_obj} }, ref $owner_obj ;
+
+# get a new target id and the cell name
+
+ my $target = $cell_info->{'id_obj'}->next() ;
+
+ my $cell_name = $cell_info->{'cell_name'} ;
+
+# keep track of the clone in the parent and register it
+
+ $cell_info->{'clones'}{$target} = $clone ;
+
+ my $err = register_cell( $clone, $cell_name, $target ) ;
+
+ die $err if $err ;
+
+# the parent loses its args to the clone. parent cells never do real work
+
+##################
+## add parent private INFO/ARGS for use by status command
+##################
+
+ my $args = delete $cell_info->{'args'} ;
+
+# create the clone info and save it in the cloned object
+
+ my $cell_info_attr = $cell_info->{'cell_info_attr'} ;
+
+ my $from_addr = Stem::Msg::make_address_string(
+ $Stem::Vars::Hub_name,
+ $cell_name,
+ $target
+ ) ;
+
+#print "FROM ADDR $cell_info->{'from_addr'}\n" ;
+ my $clone_info = bless {
+
+ 'owner_obj' => $clone,
+ 'parent_obj' => $owner_obj,
+ 'cell_name' => $cell_name,
+ 'target' => $target,
+ 'from_addr' => $from_addr,
+ 'args' => $args,
+ 'cell_info_attr' => $cell_info_attr,
+ map { $_ => $cell_info->{$_} } @clone_fields,
+ } ;
+
+# save the new clone info into the clone itself ;
+
+ $clone->{$cell_info_attr} = $clone_info ;
+
+ return $clone ;
+}
+
+sub _clone_delete {
+
+ my ( $self ) = @_ ;
+
+ my $parent_obj = $self->{'parent_obj'} ;
+
+ return unless $parent_obj ;
+
+ my $owner_obj = $self->{'owner_obj'} ;
+
+ my $cell_info_attr = $self->{'cell_info_attr'} ;
+
+#print $self->cell_status_cmd() ;
+
+# break all circular links
+# delete the refs to the parent and parent objects in the cell info
+# and the owner object ref to this cell info
+
+ delete @{$self}{ qw( owner_obj parent_obj ) } ;
+ delete $owner_obj->{$cell_info_attr} ;
+
+ delete $self->{'args'} ;
+
+# clean up the parent clones hash and the registry
+
+ my $parent_info = $parent_obj->{$cell_info_attr} ;
+ my $target = $self->{'target'} ;
+
+ delete $parent_info->{'clones'}{$target} ;
+ $parent_info->{'id_obj'}->delete( $target ) ;
+
+ my $err = unregister_cell( $owner_obj ) ;
+}
+
+1 ;
--- /dev/null
+# File: Stem/Cell/Flow.pm
+
+# This file is part of Stem.
+# Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
+
+# Stem is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# Stem is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with Stem; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# For a license to use the Stem under conditions other than those
+# described here, to purchase support for this software, or to purchase a
+# commercial warranty contract, please contact Stem Systems at:
+
+# Stem Systems, Inc. 781-643-7504
+# 79 Everett St. info@stemsystems.com
+# Arlington, MA 02474
+# USA
+
+package Stem::Cell ;
+
+use strict ;
+
+my $grammar = <<'GRAMMAR' ;
+
+flow : list /\s*\Z/ { $item[1] }
+
+top_list : list
+
+list : statement(s)
+
+statement : ifelse |
+ if |
+ while |
+ delay |
+ next |
+ stop |
+ method |
+ <error>
+
+ifelse : /(?:if|unless)\b/i method_call block /else/i block {
+ {
+ op => 'IF',
+ not => lc $item[1] eq 'unless' ?
+ 1 : 0,
+ cond => $item[2],
+ then => $item[3],
+ else => $item[5]
+ }
+ }
+
+if : /(?:if|unless)\b/i method_call block {
+ {
+ op => 'IF',
+ not => lc $item[1] eq 'unless' ?
+ 1 : 0,
+ cond => $item[2],
+ then => $item[3],
+ }
+ }
+
+while : label(?) /(?:while|until)\b/i method_call block {
+ {
+ op => 'WHILE',
+ label => $item[1][0] || '',
+ not => lc $item[2] eq 'until' ?
+ 1 : 0,
+ cond => $item[3],
+ block => $item[4]
+ }
+ }
+
+next : /(?:next|last)\b/i name(?) ';' {
+ {
+ op => 'NEXT',
+ last => lc $item[1] eq 'last',
+ label => $item[2][0] || ''
+ }
+ }
+
+delay : /delay\b/i ( delay_value | delay_method ) ';' {
+ {
+ op => 'DELAY',
+ @{$item[2]}
+ }
+ }
+
+
+stop : /stop/i ';' {
+ {
+ op => 'STOP',
+ }
+ }
+
+label : name ':' { $item[1] }
+
+delay_value : /\d+/ {
+ [value => $item[1]]
+ }
+
+delay_method : method_call {
+ [method => $item[1]]
+ }
+
+method : method_call ';' { $item[1] }
+
+method_call : args_method | plain_method
+
+plain_method : name {
+ {
+ op => 'METHOD',
+ method => $item[1],
+ }
+ }
+
+args_method : name '(' arg(s /,/) ')' {
+ {
+ op => 'METHOD',
+ method => $item[1],
+ args => $item[3],
+ }
+ }
+
+arg : /\w+/
+
+name : /[^\W\d]\w*/
+
+block : '{' list '}' { $item[2] }
+
+GRAMMAR
+
+my $flow_parser ;
+my %flows ;
+
+my %flow_ops = (
+
+ WHILE => \&flow_while_op,
+ IF => \&flow_if_op,
+ NEXT => \&flow_next_op,
+ METHOD => \&flow_method_op,
+ DELAY => \&flow_delay_op,
+ STOP => \&flow_stop_op,
+) ;
+
+
+$::RD_HINT = 1 ;
+$::RD_ERRORS = 1 ;
+
+use Data::Dumper ;
+
+sub cell_flow_init {
+
+ my( $self, $name, $source ) = @_ ;
+
+ my $cell_info = $self->_get_cell_info() ;
+
+ unless( $flow_parser ) {
+
+ require Parse::RecDescent ;
+
+ $flow_parser = Parse::RecDescent->new( $grammar ) or
+ die 'bad flow grammar' ;
+ }
+
+ my $tree = $flows{$name}{'tree'} ;
+
+ unless( $tree ) {
+
+ $source =~ s/#.+$//mg ;
+
+ $tree = $flow_parser->flow( $source ) ;
+
+#print Dumper $tree ;
+
+ $flows{$name} = {
+
+ 'tree' => $tree,
+ 'source' => $source,
+ } ;
+ }
+
+ $cell_info->{'flow'} = {
+
+ 'name' => $name,
+ 'tree' => $tree,
+ 'pc' => [ $tree, 0 ],
+ } ;
+
+ return ;
+}
+
+sub cell_flow_go_in {
+
+ my( $self, $msg ) = @_ ;
+
+ my $cell_info = $self->_get_cell_info() ;
+
+#print $msg->dump( 'GO') if $msg ;
+
+#print "GO\n" ;
+ my $flow = $cell_info->{'flow'} ;
+
+#print Dumper $flow ;
+
+ while( 1 ) {
+
+ my ( $pc_ref, $pc_index ) = @{$flow->{'pc'}} ;
+
+#print "IND $pc_index ", Dumper $pc_ref ;
+
+ if ( $pc_index >= @{$pc_ref} ) {
+
+#print "LIST END\n" ;
+
+ my $old_pc = pop( @{$flow->{'stack'}} ) ;
+
+ $old_pc or die "FELL off FLOW STACK" ;
+
+#print "POP\n" ;
+
+ $flow->{'pc'} = $old_pc ;
+ next ;
+ }
+
+ my $op = $pc_ref->[$pc_index] ;
+
+ my $op_name = $op->{'op'} ;
+
+#print "OP $op_name\n" ;
+
+ my $code = $flow_ops{$op_name} ;
+
+ $code or die "unknown flow op code [$code]" ;
+
+ my $meth_val = $code->( $flow, $op, $self, $msg ) ;
+
+ $msg = undef ;
+
+ next unless $meth_val ;
+
+ return if $meth_val && $meth_val eq 'FLOW_STOP' ;
+
+# check for a message
+
+ if ( ref $meth_val eq 'Stem::Msg' ) {
+
+ $meth_val->reply_type( 'cell_flow_go' ) ;
+
+ $meth_val->dispatch() ;
+
+ return ;
+ }
+
+ return ;
+ }
+
+ return ;
+}
+
+sub flow_stop_op {
+
+ my( $flow ) = @_ ;
+
+ my $pc = $flow->{'pc'} ;
+
+# always go to the next op
+
+ $pc->[1]++ ;
+ return 'FLOW_STOP' ;
+}
+
+sub flow_method_op {
+
+ my( $flow, $op, $obj, $msg ) = @_ ;
+
+ my $pc = $flow->{'pc'} ;
+
+# always go to the next op
+
+ $pc->[1]++ ;
+
+#print Dumper $pc ;
+
+ return( flow_call_method( $op, $obj, $msg ) ) ;
+}
+
+sub flow_while_op {
+
+ my( $flow, $op, $obj ) = @_ ;
+
+ my $pc = $flow->{'pc'} ;
+
+ my $cond_val = flow_cond( $op, $obj ) ;
+
+ unless( $cond_val ) {
+
+#print "WHILE END\n" ;
+
+ $pc->[1]++ ;
+ return ;
+ }
+
+#print "WHILE LOOP\n" ;
+
+ push( @{$flow->{'stack'}}, $pc ) ;
+
+ $flow->{'pc'} = [ $op->{'block'}, 0 ] ;
+
+ return ;
+}
+
+sub flow_if_op {
+
+ my( $flow, $op, $obj ) = @_ ;
+
+ my $cond_val = flow_cond( $op, $obj ) ;
+
+ my $block = $cond_val ? $op->{'then'} : $op->{'else'} ;
+
+ my $pc = $flow->{'pc'} ;
+
+# always go to the next op
+
+ $pc->[1]++ ;
+
+ if ( $block ) {
+
+ push( @{$flow->{'stack'}}, $pc ) ;
+
+ $flow->{'pc'} = [ $block, 0 ] ;
+ }
+
+ return ;
+}
+
+sub flow_next_op {
+
+ my( $flow, $op, $obj ) = @_ ;
+
+ my $label = $op->{'label'} ;
+
+ while( 1 ) {
+
+ my $pc = pop( @{$flow->{'stack'}} ) ;
+
+ $pc or die "can't find label '$label' in flow stack" ;
+
+#print "PC: ", Dumper $pc ;
+
+ my $prev_op = $pc->[0][$pc->[1]] ;
+
+#print "PREV: ", Dumper $prev_op ;
+
+ next unless $prev_op && $prev_op->{'op'} eq 'WHILE' ;
+
+#print "FOUND WHILE\n" ;
+
+ next unless $prev_op->{'label'} eq $label ;
+
+ $pc->[1]++ if $op->{'last'} ;
+
+#print "LAST PC: ", Dumper $pc ;
+
+ $flow->{'pc'} = $pc ;
+
+ return ;
+ }
+}
+
+
+sub flow_delay_op {
+
+ my( $flow, $op, $obj ) = @_ ;
+
+#print Dumper $op ;
+
+ my $pc = $flow->{'pc'} ;
+ $pc->[1]++ ;
+
+ my $delay = $op->{'value'} ;
+
+ unless ( defined $delay ) {
+
+ $delay = flow_call_method( $op->{'method'}, $obj ) ;
+ }
+
+ $flow->{'timer'} = Stem::Event::Timer->new(
+ 'object' => $obj,
+ 'method' => 'cell_flow_go_in',
+ 'delay' => $delay,
+ 'hard' => 1,
+ 'single' => 1,
+ ) ;
+
+# print "D $delay EVT $flow->{'timer'}\n" ;
+
+ return 1 ;
+}
+
+sub flow_cond {
+
+ my( $op, $obj ) = @_ ;
+
+ my $cond = $op->{'cond'} ;
+
+ return 1 if $cond eq '1' ;
+
+ my $cond_val = flow_call_method( $cond, $obj ) ? 1 : 0 ;
+
+ return( $cond_val ^ $op->{'not'} ) ;
+}
+
+sub flow_call_method {
+
+ my( $call, $obj, $msg ) = @_ ;
+
+ my $method = $call->{'method'} ;
+
+ my @args = @{$call->{'args'} || []} ;
+
+ unshift( @args, $msg ) if $msg ;
+
+# flow methods are always called in scalar context
+
+#print "METHOD $method ( @args )\n" ;
+
+ my $val = $obj->$method( @args ) ;
+
+ return $val ;
+}
+
+
+1 ;
--- /dev/null
+# File: Stem/Cell/Pipe.pm
+
+# This file is part of Stem.
+# Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
+
+# Stem is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# Stem is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with Stem; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# For a license to use the Stem under conditions other than those
+# described here, to purchase support for this software, or to purchase a
+# commercial warranty contract, please contact Stem Systems at:
+
+# Stem Systems, Inc. 781-643-7504
+# 79 Everett St. info@stemsystems.com
+# Arlington, MA 02474
+# USA
+
+package Stem::Cell ;
+
+use strict ;
+
+sub _cell_pipe {
+
+ my( $self ) = @_ ;
+
+ if ( $self->{'args'}{'pipe_open'} ) {
+
+ $self->{'piped'} = 1 ;
+
+# return the connection handshake
+
+ my $addr_msg = Stem::Msg->new(
+ 'cmd' => 'cell_pipe_addr',
+ 'to' => $self->{'args'}{'data_addr'},
+ 'from' => $self->{'from_addr'},
+ ) ;
+
+ $addr_msg->dispatch() ;
+
+ return ;
+ }
+
+ my $pipe_addr = $self->{'args'}{'pipe_addr'} || $self->{'pipe_addr'} ;
+
+ return unless $pipe_addr ;
+
+ $self->{'piped'} = 1 ;
+
+# start the pipe connection handshake
+
+ my $open_msg = Stem::Msg->new(
+ 'cmd' => 'cell_trigger',
+ 'to' => $pipe_addr,
+ 'from' => $self->{'from_addr'},
+ 'data' => {
+ 'args' => $self->{'pipe_args'},
+ 'pipe_open' => 1,
+ 'data_addr' => $self->{'from_addr'},
+ },
+ ) ;
+
+ $open_msg->dispatch() ;
+}
+
+# this command sub sets the data address at the end of a pipe handshake
+
+sub cell_pipe_addr_cmd {
+
+ my( $self, $msg ) = @_ ;
+
+ my $cell_info = $self->_get_cell_info() ;
+
+ $cell_info->{'data_addr'} = $msg->from() ;
+
+ my $err = $cell_info->{'gather'}->gathered( 'data_addr' ) ;
+ return $err if $err ;
+
+ return ;
+}
+
+sub cell_pipe_close_cmd {
+
+ my( $self, $msg ) = @_ ;
+
+#print $msg->dump( 'PIPE' ) ;
+
+# TraceStatus "pipe closed cmd" ;
+
+ my $cell_info = $self->_get_cell_info() ;
+
+ $cell_info->{'close_cmd_seen'} = 1 ;
+
+ my $data = $msg->data() ;
+
+# see if we dump the errors to the output handle
+
+ if ( $data && $cell_info->{'errors_to_output'} ) {
+
+ $data = <<ERR ;
+Cell::Pipe Error
+$data
+ERR
+ $cell_info->_cell_write_sync( \$data ) ;
+ }
+
+
+
+ $self->cell_shut_down() ;
+
+ return ;
+}
+
+sub _close_pipe {
+
+ my( $self ) = @_ ;
+
+ return if $self->{'close_cmd_seen'} ;
+
+use Carp qw( cluck ) ;
+#cluck() ;
+#print $self->_dump( 'CLOSE PIPE' ) ;
+
+ return unless $self->{'piped'} ;
+
+# TraceStatus "pipe closing" ;
+
+ my $to_addr = $self->{'args'}{'data_addr'} ||
+ $self->{'data_addr'} ;
+
+ my $close_msg = Stem::Msg->new(
+ 'cmd' => 'cell_pipe_close',
+ 'to' => $to_addr,
+ 'from' => $self->{'from_addr'},
+ 'data' => $self->{'error'},
+ ) ;
+
+#print $close_msg->dump( '_close PIPE' ) ;
+
+ $close_msg->dispatch() ;
+}
+
+1 ;
--- /dev/null
+# File: Stem/Cell/Sequence.pm
+
+# This file is part of Stem.
+# Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
+
+# Stem is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# Stem is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with Stem; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# For a license to use the Stem under conditions other than those
+# described here, to purchase support for this software, or to purchase a
+# commercial warranty contract, please contact Stem Systems at:
+
+# Stem Systems, Inc. 781-643-7504
+# 79 Everett St. info@stemsystems.com
+# Arlington, MA 02474
+# USA
+
+package Stem::Cell ;
+
+use strict ;
+
+sub cell_set_sequence {
+
+ my( $self, @sequence ) = @_ ;
+
+ my $cell_info = $self->_get_cell_info() ;
+
+#print "@sequence\n" ;
+
+ $cell_info->{'sequence'} = [ @sequence ] ;
+ $cell_info->{'sequence_left'} = [ @sequence ] ;
+
+ return ;
+}
+
+
+sub cell_reset_sequence {
+
+ my( $self ) = @_ ;
+
+ my $cell_info = $self->_get_cell_info() ;
+
+ $cell_info->{'sequence_left'} = [ @{$cell_info->{'sequence'}} ] ;
+
+ return ;
+}
+
+sub cell_replace_next_sequence {
+
+ my( $self, $method ) = @_ ;
+
+ my $cell_info = $self->_get_cell_info() ;
+
+ $cell_info->{'sequence_left'}[0] = $method;
+
+ return ;
+}
+
+#
+# This method lets you basically set up loops. For example, method X
+# could insert itself as the next next method in the sequence. Then,
+# when it is called again it can decide whether or not to insert
+# itself again.
+#
+# A more complex example might see method X might say "now execute Y,
+# Z, M, and X", which allows you to create loops. Then method Z might
+# say "now execute Q and Z".
+#
+# Obviously, most loops will also need a break condition where method
+# X decides _not_ to insert itself into the sequence.
+#
+sub cell_insert_next_sequence {
+
+ my( $self, @sequence ) = @_ ;
+
+ my $cell_info = $self->_get_cell_info() ;
+
+ unshift @{ $cell_info->{'sequence_left'} }, @sequence;
+
+ return ;
+}
+
+sub cell_skip_next_sequence {
+
+ my( $self, $count ) = @_ ;
+
+ $count ||= 1 ;
+
+ my $cell_info = $self->_get_cell_info() ;
+
+ shift @{ $cell_info->{'sequence_left'} } for 1..$count;
+
+ return ;
+}
+
+sub cell_skip_until_method {
+
+ my( $self, $method ) = @_ ;
+
+ my $cell_info = $self->_get_cell_info() ;
+
+ my $seq_left = $cell_info->{'sequence_left'} ;
+
+ while( @{$seq_left} ) {
+
+ return if $seq_left->[0] eq $method ;
+ shift @{$seq_left} ;
+ }
+
+ die "skip sequence method $method is not found" ;
+}
+
+
+sub cell_next_sequence_in {
+
+ my( $self, $msg ) = @_ ;
+
+#print $msg->dump( "NEXT IN" ) if $msg ;
+
+ my $cell_info = $self->_get_cell_info() ;
+
+ $cell_info->cell_next_sequence( $msg ) ;
+}
+
+sub cell_next_sequence {
+
+ my( $self, $in_msg ) = @_ ;
+
+#print caller(), "\n" ;
+
+#print $in_msg->dump('SEQ IN') if $in_msg ;
+
+ my $cell_info = $self->_get_cell_info() ;
+
+ my $owner_obj = $cell_info->{'owner_obj'} ;
+
+
+ while( my $next_sequence = shift @{$cell_info->{'sequence_left'}} ) {
+
+#print "LEFT @{$cell_info->{'sequence_left'}}\n" ;
+
+ die "cannot call sequence method $next_sequence"
+ unless $owner_obj->can( $next_sequence ) ;
+
+#print "SEQ: $next_sequence\n" ;
+
+ my $seq_val = $owner_obj->$next_sequence( $in_msg ) ;
+
+# don't pass in the message more than once.
+
+ $in_msg = undef ;
+
+ next unless $seq_val ;
+
+ if ( ref $seq_val eq 'Stem::Msg' ) {
+
+
+#print caller() ;
+#print $seq_val->dump( 'SEQ: MSG' ) ;
+ $seq_val->reply_type( 'cell_next_sequence' ) ;
+
+ $seq_val->dispatch() ;
+
+ return ;
+ }
+
+ if ( ref $seq_val eq 'HASH' ) {
+
+ my $delay = $seq_val->{'delay'} ;
+
+ if ( defined( $delay ) ) {
+
+ $cell_info->cell_sequence_delay( $delay ) ;
+ return ;
+ }
+ }
+ }
+
+ if ( my $seq_done_method = $cell_info->{'sequence_done_method'} ) {
+
+ $owner_obj->$seq_done_method() ;
+
+ return ;
+ }
+
+#warn "FELL off end of sequence" ;
+
+ return ;
+}
+
+sub cell_sequence_delay {
+
+ my( $self, $delay ) = @_ ;
+
+ my $cell_info = $self->_get_cell_info() ;
+
+#print "SEQ DELAY $delay\n" ;
+
+ $cell_info->{'timer'} = Stem::Event::Timer->new(
+ 'object' => $cell_info,
+ 'method' => 'cell_next_sequence',
+ 'delay' => $delay,
+ 'hard' => 1,
+ 'single' => 1,
+ ) ;
+}
+
+1 ;
--- /dev/null
+# File: Stem/Cell/Work.pm
+
+# This file is part of Stem.
+# Copyright (C) 1999, 2000, 2001, 2002 Stem Systems, Inc.
+
+# Stem is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# Stem is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with Stem; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# For a license to use the Stem under conditions other than those
+# described here, to purchase support for this software, or to purchase a
+# commercial warranty contract, please contact Stem Systems at:
+
+# Stem Systems, Inc. 781-643-7504
+# 79 Everett St. info@stemsystems.com
+# Arlington, MA 02474
+# USA
+
+package Stem::Cell ;
+
+use strict ;
+
+
+sub cell_worker_ready {
+
+ my ( $self ) = @_ ;
+
+ my $cell_info = $self->_get_cell_info() ;
+
+ my $ready_addr = $cell_info->{'work_ready_addr'} ;
+
+ return unless $ready_addr ;
+
+#print "READY addr [$ready_addr]\n" ;
+
+ my $worker_msg = Stem::Msg->new(
+ 'to' => $ready_addr,
+ 'type' => 'worker',
+ 'from' => $cell_info->{'from_addr'},
+ ) ;
+
+#print $worker_msg->dump('worker ready') ;
+
+ $worker_msg->dispatch() ;
+
+ return ;
+}
+
+sub cell_work_in {
+
+ my ( $self, $msg ) = @_ ;
+
+#print $msg->dump( 'WORK MSG' ) ;
+
+##################
+# handle error: work when work in progress. check 'work_msg'
+#################
+
+ my $cell_info = $self->_get_cell_info() ;
+
+ my $obj = $msg->data() ;
+
+ my $packet_text = $cell_info->{'packet'}->to_packet( $obj ) ;
+
+ $cell_info->cell_write( $packet_text ) ;
+}
+
+1 ;
--- /dev/null
+package Stem::ChatLabel ;
+
+use strict ;
+
+
+my $attr_spec = [
+
+ {
+ 'name' => 'sw_addr',
+ 'help' => <<HELP,
+This is the address of the chat switch
+HELP
+ },
+] ;
+
+sub new {
+
+ my( $class ) = shift ;
+
+ my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
+ return $self unless ref $self ;
+
+ return $self ;
+}
+
+sub data_in {
+
+ my ( $self, $msg ) = @_ ;
+
+ my $data = $msg->data() ;
+
+#print "$$data" ;
+
+ substr( $$data, 0, 0, $msg->from_cell() . ': ' ) ;
+
+ $msg->data( $data ) ;
+ $msg->to_cell( $self->{'sw_addr'} ) ;
+
+ $msg->dispatch() ;
+}
+
+1 ;
--- /dev/null
+# File: Stem/Class.pm
+
+# This file is part of Stem.
+# Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
+
+# Stem is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# Stem is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with Stem; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# For a license to use the Stem under conditions other than those
+# described here, to purchase support for this software, or to purchase a
+# commercial warranty contract, please contact Stem Systems at:
+
+# Stem Systems, Inc. 781-643-7504
+# 79 Everett St. info@stemsystems.com
+# Arlington, MA 02474
+# USA
+
+package Stem::Class ;
+
+use strict ;
+
+#use Data::Dumper ;
+
+# dispatch table for attribute 'type' checking and conversion
+
+my %type_to_code = (
+
+ 'boolean' => \&_type_boolean,
+ 'hash' => \&_type_hash,
+ 'list' => \&_type_list,
+ 'HoL' => \&_type_hash_of_list,
+ 'LoL' => \&_type_list_of_list,
+ 'HoH' => \&_type_hash_of_hash,
+ 'LoH' => \&_type_list_of_hash,
+ 'addr' => \&_type_address,
+ 'address' => \&_type_address,
+ 'obj' => \&_type_object,
+ 'object' => \&_type_object,
+ 'cb_object' => \&_type_object,
+ 'handle' => \&_type_handle,
+) ;
+
+sub parse_args {
+
+ my( $attr_spec, %args_in ) = @_ ;
+
+ my( $package ) = caller ;
+
+#print "PACK $package\n" ;
+
+ my $obj = bless {}, $package ;
+
+#print Dumper( $attr_spec ) ;
+#print "class args ", Dumper( \%args_in ) ;
+
+ my( $cell_info_obj, $cell_info_name ) ;
+
+ my $reg_name = $args_in{ 'reg_name' } || '' ;
+
+ foreach my $field ( @{$attr_spec} ) {
+
+ my $field_name = $field->{'name'} or next ;
+
+ my $field_val = $args_in{ $field_name } ;
+
+ if ( my $class = $field->{'class'} ) {
+
+# optinally force a sub-object build by passing a default empty list
+# for its value
+# Stem::Cell is always built
+
+ if ( $field->{'always_create'} ||
+ $class eq 'Stem::Cell' ) {
+
+ $field_val ||= [] ;
+ }
+
+ my @class_args ;
+
+ if ( ref $field_val eq 'HASH' ) {
+
+ @class_args = %{$field_val} ;
+ }
+ elsif ( ref $field_val eq 'ARRAY' ) {
+
+ @class_args = @{$field_val} ;
+ }
+ else {
+ next ;
+ }
+
+ my $class_args = $field->{'class_args'} ;
+
+ if ( $class_args && ref $class_args eq 'HASH' ) {
+
+ push( @class_args, %{$class_args} ) ;
+ }
+ elsif ( $class_args && ref $class_args eq 'ARRAY' ) {
+
+ push( @class_args, @{$class_args} ) ;
+ }
+
+# Stem::Cell wants to know its owner's cell name
+
+ push( @class_args, 'reg_name' => $reg_name )
+ if $class eq 'Stem::Cell' ;
+
+ $field_val = $class->new( @class_args ) ;
+
+ return <<ERR unless $field_val ;
+Missing attribute class object for '$field_name' for class $package
+ERR
+
+ return $field_val unless ref $field_val ;
+
+# track the field info for Stem::Cell for use later
+
+ if ( $class eq 'Stem::Cell' ) {
+
+ $cell_info_obj = $field_val ;
+ $cell_info_name = $field_name ;
+ }
+ }
+
+# handle a callback type attribute. it does all the parsing and object stuffing
+# the callback should return
+
+ if ( my $callback = $field->{'callback'} and $field_val ) {
+
+
+ my $cb_err = $callback->( $obj,
+ $field_name, $field_val ) ;
+
+ return $cb_err if $cb_err ;
+
+ next ;
+ }
+
+ if ( my $env_name = $field->{'env'} ) {
+
+ my @prefixes = ( $reg_name ) ?
+ ( "${reg_name}:", "${reg_name}_", '' ) :
+ ( '' ) ;
+
+ foreach my $prefix ( @prefixes ) {
+
+#print "ENV NAME [$prefix$env_name]\n" ;
+
+ my $env_val =
+ $Stem::Vars::Env{"$prefix$env_name"} ;
+
+ next unless defined $env_val ;
+
+ $field_val = $env_val ;
+#print "ENV field $field_name [$env_val]\n" ;
+ last ;
+ }
+ }
+
+ unless( defined $field_val ) {
+
+ if ( $field->{'required'} ) {
+
+ return <<ERR ;
+Missing required field '$field_name' for class $package
+ERR
+ }
+
+ $field_val = $field->{'default'}
+ if exists $field->{'default'} ;
+ }
+
+#print "field $field_name [$field_val]\n" ;
+
+ next unless defined $field_val ;
+
+ if ( my $type = $field->{'type'} ) {
+
+ my $type_code = $type_to_code{$type} ;
+ return "Unknown attribute type '$type'"
+ unless $type_code ;
+
+ my $err = $type_code->(
+ \$field_val, $type, $field_name ) ;
+#print "ERR $err\n" ;
+ return $err if $err ;
+ }
+
+ $obj->{$field_name} = $field_val ;
+ }
+
+ if ( $cell_info_obj ) {
+
+ return <<ERR unless $reg_name ;
+Missing 'name' in configuration for class $package.
+It is required for use by Stem::Cell
+ERR
+
+ $cell_info_obj->cell_init( $obj,
+ $reg_name,
+ $cell_info_name
+ ) ;
+ }
+
+#print "class obj ", Dumper( $obj ) ;
+
+ return $obj ;
+}
+
+sub _type_boolean {
+
+ my ( $val_ref, $type ) = @_ ;
+
+ return if ${$val_ref} =~ s/^(?:|1|Y|Yes)$/1/i ||
+ ${$val_ref} =~ s/^(?:|0|N|No)$/0/i ;
+
+ return "Attribute value '${$val_ref}' is not boolean"
+}
+
+sub _type_object {
+
+ my ( $val_ref, $type ) = @_ ;
+
+ return if ref ${$val_ref} ;
+
+ return "Attribute value '${$val_ref}' is not an object"
+}
+
+sub _type_address {
+
+ my ( $val_ref, $type, $name ) = @_ ;
+
+ my( $to_hub, $cell_name, $target ) =
+ Stem::Msg::split_address( ${$val_ref} ) ;
+
+ return if $cell_name ;
+
+ return "Attribute $name: value '${$val_ref}' is not a valid Stem address"
+}
+
+sub _type_handle {
+
+ my ( $val_ref, $type ) = @_ ;
+
+ return if defined fileno( ${$val_ref} ) ;
+
+ return "Attribute value '${$val_ref}' is not an open IO handle"
+}
+
+sub _type_list {
+
+ my ( $val_ref, $type ) = @_ ;
+
+ my $err = _convert_to_list( $val_ref ) ;
+
+ return unless $err ;
+
+ return "Attribute value '${$val_ref}' is not a list\n$err" ;
+}
+
+sub _type_hash {
+
+ my ( $val_ref, $type ) = @_ ;
+
+ my $err = _convert_to_hash( $val_ref ) ;
+
+ return unless $err ;
+
+ return "Attribute value '${$val_ref}' is not a hash\n$err" ;
+}
+
+sub _type_list_of_list {
+
+ my ( $val_ref, $type ) = @_ ;
+
+#print Dumper $val_ref ;
+ my $err = _convert_to_list( $val_ref ) ;
+
+#print Dumper $val_ref ;
+
+ return $err if $err ;
+
+ foreach my $sub_val ( @{$$val_ref}) {
+
+ $err = _convert_to_list( \$sub_val ) ;
+ return <<ERR if $err ;
+Attribute's secondary value '$sub_val' can't be converted to a list\n$err" ;
+ERR
+ }
+
+#print Dumper $val_ref ;
+
+ return ;
+}
+
+sub _type_list_of_hash {
+
+ my ( $val_ref, $type ) = @_ ;
+
+#print Dumper $val_ref ;
+ my $err = _convert_to_list( $val_ref ) ;
+
+#print Dumper $val_ref ;
+
+ return $err if $err ;
+
+ foreach my $sub_val ( @{$$val_ref}) {
+
+ $err = _convert_to_hash( \$sub_val ) ;
+ return <<ERR if $err ;
+Attribute's secondary value '$sub_val' can't be converted to a hash\n$err" ;
+ERR
+ }
+
+#print Dumper $val_ref ;
+
+ return ;
+}
+
+
+sub _type_hash_of_list {
+
+ my ( $val_ref, $type ) = @_ ;
+
+#print Dumper $val_ref ;
+ my $err = _convert_to_hash( $val_ref ) ;
+
+#print Dumper $val_ref ;
+
+ return $err if $err ;
+
+ foreach my $val ( values %{$$val_ref}) {
+
+ $err = _convert_to_list( \$val ) ;
+ return <<ERR if $err ;
+Attribute's secondary value '$val' can't be converted to a list\n$err" ;
+ERR
+ }
+
+#print Dumper $val_ref ;
+
+ return ;
+}
+
+sub _type_hash_of_hash {
+
+ my ( $val_ref, $type ) = @_ ;
+
+#print Dumper $val_ref ;
+ my $err = _convert_to_hash( $val_ref ) ;
+
+#print Dumper $val_ref ;
+
+ return $err if $err ;
+
+ foreach my $val ( values %{$$val_ref}) {
+
+ $err = _convert_to_hash( \$val ) ;
+ return <<ERR if $err ;
+Attribute's secondary value '$val' can't be converted to a hash\n$err" ;
+ERR
+ }
+
+#print Dumper $val_ref ;
+
+ return ;
+}
+
+sub _convert_to_list {
+
+ my ( $val_ref ) = @_ ;
+
+ my $val_type = ref ${$val_ref} ;
+
+ return if $val_type eq 'ARRAY' ;
+
+ unless ( $val_type ) {
+
+ ${$val_ref} = [ ${$val_ref} ] ;
+ return ;
+ }
+
+ if ( $val_type eq 'HASH' ) {
+
+ ${$val_ref} = [ %{${$val_ref}} ] ;
+ return ;
+ }
+
+ return 'It must be a scalar or a reference to an array or hash' ;
+}
+
+sub _convert_to_hash {
+
+ my ( $val_ref ) = @_ ;
+
+ my $val_type = ref ${$val_ref} ;
+
+ return if $val_type eq 'HASH' ;
+
+ if ( $val_type eq 'ARRAY' ) {
+
+ ${$val_ref} = { @{${$val_ref}} } ;
+ return ;
+ }
+
+ return 'It must be a reference to an array or hash' ;
+}
+
+1 ;
--- /dev/null
+# File: Stem/Codec/.pm
+
+# This file is part of Stem.
+# Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
+
+# Stem is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# Stem is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with Stem; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# For a license to use the Stem under conditions other than those
+# described here, to purchase support for this software, or to purchase a
+# commercial warranty contract, please contact Stem Systems at:
+
+# Stem Systems, Inc. 781-643-7504
+# 79 Everett St. info@stemsystems.com
+# Arlington, MA 02474
+# USA
+
+package Stem::Codec ;
+
+use strict ;
+
+use Stem::Class ;
+
+my $attr_spec = [
+
+ {
+ 'name' => 'codec',
+ 'default' => 'Data::Dumper',
+ 'help' => <<HELP,
+This is the name of the Codec:: subclass that will be used in this cell
+HELP
+ },
+ {
+ 'name' => 'object',
+ 'type' => 'object',
+ 'help' => <<HELP,
+If an object is passed in, the filter will use it for callbacks
+HELP
+ },
+
+ {
+ 'name' => 'encode_method',
+ 'default' => 'encoded_data',
+ 'help' => <<HELP,
+HELP
+ },
+
+ {
+ 'name' => 'decode_method',
+ 'default' => 'decoded_data',
+ 'help' => <<HELP,
+HELP
+ },
+
+] ;
+
+
+###########
+# This POD section is autoegenerated. Any edits to it will be lost.
+
+=head2 Constructor Attributes for Class Stem::Codec::Data::Dumper
+
+=over 4
+
+
+=item * Attribute - B<object>
+
+=over 4
+
+
+=item Description:
+If an object is passed in, the filter will use it for callbacks
+
+
+=item Its B<type> is: object
+
+=back
+
+=item * Attribute - B<encode_method>
+
+=over 4
+
+
+=item It B<defaults> to: encoded_data
+
+=back
+
+=item * Attribute - B<decode_method>
+
+=over 4
+
+
+=item It B<defaults> to: decoded_data
+
+=back
+
+=back
+
+=cut
+
+# End of autogenerated POD
+###########
+
+my %loaded_codecs ;
+
+sub new {
+
+ my( $class ) = shift ;
+
+ my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
+ return $self unless ref $self ;
+
+ my $err = $self->load_codec() ;
+ return $err if $err ;
+
+ return $self ;
+}
+
+sub load_codec {
+
+ my( $self ) = @_ ;
+
+ my $codec = $self->{codec} ;
+
+ return if $loaded_codecs{ $codec } ;
+
+ my $codec_class = "Stem::Codec::$codec" ;
+
+ eval "require $codec_class" ;
+
+ return "Can't load Stem codec '$codec_class' $@" if $@ ;
+
+ $loaded_codecs{ $codec } = {
+
+ encoder => $codec_class->make_encoder(),
+ decoder => $codec_class->make_decoder(),
+ } ;
+
+ return ;
+}
+
+sub encode {
+
+ my $self = shift ;
+
+ return unless @_ ;
+
+ my $encoder = $loaded_codecs{ $self->{codec} }{encoder} ;
+
+# make sure scalars and scalar refs have a ref taken to them as codecs
+# always take a ref. we do ref on scalar refs so we can tell at decode
+# time that REF is a scalar ref but SCALAR is a plain scalar
+
+#print "IN $_[0] REF ", ref $_[0], "\n" ;
+
+ my $data_ref = ( ! ref $_[0] || ref $_[0] eq 'SCALAR' ) ?
+ \$_[0] : $_[0] ;
+
+#print "DATA REF $data_ref\n" ;
+
+ my $encoded_text = $encoder->( $data_ref ) ;
+
+ if ( my $obj = $self->{'object'} ) {
+
+ my $method = $self->{'encode_method'} ;
+ $obj->$method( $encoded_text ) ;
+ }
+
+ return $encoded_text ;
+}
+
+sub decode {
+
+ my $self = shift ;
+
+ my $decoder = $loaded_codecs{ $self->{codec} }{decoder} ;
+
+ my $decoded_data = $decoder->( $_[0] ) ;
+
+ $decoded_data = ${$decoded_data} if
+ ref $decoded_data eq 'SCALAR' ||
+ ref $decoded_data eq 'REF' ;
+
+ if ( my $obj = $self->{'object'} ) {
+
+ my $method = $self->{'decode_method'} ;
+ $obj->$method( $decoded_data ) ;
+ }
+
+ return( $decoded_data ) ;
+}
+
+1 ;
--- /dev/null
+# File: Stem/Codec/Data/Dumper.pm
+
+# This file is part of Stem.
+# Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
+
+# Stem is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# Stem is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with Stem; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# For a license to use the Stem under conditions other than those
+# described here, to purchase support for this software, or to purchase a
+# commercial warranty contract, please contact Stem Systems at:
+
+# Stem Systems, Inc. 781-643-7504
+# 79 Everett St. info@stemsystems.com
+# Arlington, MA 02474
+# USA
+
+package Stem::Codec::Data::Dumper ;
+
+use strict ;
+use Data::Dumper ;
+
+$Data::Dumper::Purity = 1 ;
+
+sub make_encoder {
+
+# strip out the '$VAR = ' stuff
+
+ return sub { \substr( Dumper( $_[0] ), 8 ) } ;
+# return sub { \Dumper( $_[0] ) } ;
+}
+
+sub make_decoder {
+
+ return sub { eval $_[0] } ;
+}
+
+1 ;
--- /dev/null
+# File: Stem/Codec/Storable.pm
+
+# This file is part of Stem.
+# Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
+
+# Stem is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# Stem is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with Stem; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# For a license to use the Stem under conditions other than those
+# described here, to purchase support for this software, or to purchase a
+# commercial warranty contract, please contact Stem Systems at:
+
+# Stem Systems, Inc. 781-643-7504
+# 79 Everett St. info@stemsystems.com
+# Arlington, MA 02474
+# USA
+
+package Stem::Codec::Storable ;
+
+use strict ;
+use Storable () ;
+
+sub make_encoder {
+
+ return sub { \Storable::freeze( $_[0] ) } ;
+}
+
+sub make_decoder {
+
+ return sub { Storable::thaw( $_[0] ) } ;
+}
+
+1 ;
--- /dev/null
+# File: Stem/Codec/YAML.pm
+
+# This file is part of Stem.
+# Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
+
+# Stem is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# Stem is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with Stem; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# For a license to use the Stem under conditions other than those
+# described here, to purchase support for this software, or to purchase a
+# commercial warranty contract, please contact Stem Systems at:
+
+# Stem Systems, Inc. 781-643-7504
+# 79 Everett St. info@stemsystems.com
+# Arlington, MA 02474
+# USA
+
+package Stem::Codec::YAML ;
+
+use strict ;
+use YAML () ;
+
+sub make_encoder {
+
+ return sub { \YAML::Dump( $_[0] ) } ;
+}
+
+sub make_decoder {
+
+ return sub { YAML::Load( $_[0] ) ; } ;
+}
+
+1 ;
--- /dev/null
+# File: Stem/Conf.pm
+
+# This file is part of Stem.
+# Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
+
+# Stem is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# Stem is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with Stem; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# For a license to use the Stem under conditions other than those
+# described here, to purchase support for this software, or to purchase a
+# commercial warranty contract, please contact Stem Systems at:
+
+# Stem Systems, Inc. 781-643-7504
+# 79 Everett St. info@stemsystems.com
+# Arlington, MA 02474
+# USA
+
+package Stem::Conf ;
+
+use Data::Dumper ;
+use strict ;
+
+use Stem::Vars ;
+
+use Stem::Trace 'log' => 'stem_status', 'sub' => 'TraceStatus' ;
+use Stem::Trace 'log' => 'stem_error' , 'sub' => 'TraceError' ;
+
+Stem::Route::register_class( __PACKAGE__, 'conf' ) ;
+
+my @conf_paths = split ':', $Env{ 'conf_path' } || '' ;
+if ( my $add_conf_path = $Env{ 'add_conf_path' } ) {
+
+ push @conf_paths, split( ':', $add_conf_path ) ;
+}
+
+my $attr_spec = [
+
+ {
+ 'name' => 'path',
+ 'required' => 1,
+ 'help' => <<HELP,
+This is the full path of the configuration file.
+HELP
+ },
+
+ {
+ 'name' => 'to_hub',
+ 'help' => <<HELP,
+This is the Hub that this configuration will be sent to.
+HELP
+ },
+] ;
+
+# this does not construct anything. just loads a conf file locally or remotely
+
+sub new {
+
+ my( $class ) = shift ;
+
+ my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
+ return $self unless ref $self ;
+
+ if ( my $to_hub = $self->{'to_hub'} ) {
+
+ my $conf_data = load_conf_file( $self->{'path'} ) ;
+
+ return $conf_data unless ref $conf_data ;
+
+ my $msg = Stem::Msg->new(
+ 'to_hub' => $to_hub,
+ 'to_cell' => __PACKAGE__,
+ 'from_cell' => __PACKAGE__,
+ 'type' => 'cmd',
+ 'cmd' => 'remote',
+ 'data' => $conf_data,
+ ) ;
+
+ $msg->dispatch() ;
+
+ return ;
+ }
+
+ my $err = load_conf_file( $self->{'path'}, 1 ) ;
+
+TraceError $err if $err ;
+
+ return $err if $err ;
+
+ return ;
+}
+
+
+sub load_cmd {
+
+ my( $self, $msg ) = @_ ;
+
+ my $data = $msg->data() ;
+
+ my @conf_names ;
+
+ push( @conf_names, @{$data} ) if ref $data eq 'ARRAY' ;
+ push( @conf_names, ${$data} ) if ref $data eq 'SCALAR' ;
+
+ my $err = load_confs( @conf_names ) ;
+
+TraceError $err if $err ;
+
+ return $err if $err ;
+
+ return ;
+}
+
+sub remote_cmd {
+
+ my( $self, $msg ) = @_ ;
+
+ my $err = configure( $msg->data() ) ;
+
+TraceError $err if $err ;
+
+ return $err if $err ;
+
+ return ;
+}
+
+sub load_conf_file {
+
+ my( $conf_path, $do_conf ) = @_ ;
+
+ -r $conf_path or return "$conf_path can't be read: $!" ;
+
+ my $conf_data = Stem::Util::load_file( $conf_path ) ;
+
+ return "Stem::Conf load error:\n$conf_data" unless ref $conf_data ;
+
+ return $conf_data unless $do_conf ;
+
+ my $conf_err = configure( $conf_data ) ;
+
+ return <<ERR if $conf_err ;
+Configuration error in '$conf_path'
+$conf_err
+ERR
+
+# TraceStatus "$conf_path configuration loaded." ;
+
+ return ;
+}
+
+
+sub load_confs {
+
+ my ( @conf_names ) = @_ ;
+
+ NAME:
+ foreach my $conf_name ( @conf_names ) {
+
+ $conf_name =~ s/\.stem$// ;
+
+ for my $path ( @conf_paths ) {
+
+ my $conf_path = "$path/$conf_name.stem" ;
+
+ next unless -e $conf_path ;
+
+ my $err = load_conf_file( $conf_path, 1 ) ;
+
+ return $err if $err ;
+
+ next NAME ;
+ }
+
+ local( $" ) = "\n\t" ;
+
+ return <<ERR ;
+Can't find config file '$conf_name.stem' in these directories:
+ @conf_paths
+ERR
+ }
+
+ return ;
+}
+
+my $eval_error ;
+
+sub configure {
+
+ my ( $conf_list_ref ) = @_ ;
+
+ my $class ;
+ my @notify_done; # list of objects/packages to call config_done on
+
+ foreach my $conf_ref ( @{$conf_list_ref} ) {
+
+ my %conf ;
+
+ if ( ref $conf_ref eq 'HASH' ) {
+
+ %conf = %{$conf_ref} ;
+ }
+ elsif ( ref $conf_ref eq 'ARRAY' ) {
+
+ %conf = @{$conf_ref} ;
+ }
+ else {
+ return "config entry is not an HASH or ARRAY ref\n" .
+ Dumper($conf_ref). "\n" ;
+ }
+
+ unless ( $class = $conf{'class'} ) {
+
+ return "Missing class entry in conf\n" .
+ Dumper($conf_ref) . "\n" ;
+ }
+
+# get the config name for registration
+
+ my $reg_name = $conf{'name'} || '' ;
+
+ no strict 'refs' ;
+
+ unless ( %{"::${class}"} ) {
+
+ my $module = $class ;
+ $module =~ s{::}{/}g ;
+ $module .= '.pm' ;
+
+ while( 1 ) {
+
+ my $err = eval { require $module } ;
+
+ return <<ERR if $err && $err !~ /^1/ ;
+Configure error FOO in Cell '$reg_name' from class '$class' FOO
+$eval_error
+$err
+ERR
+ last if $err ;
+
+ if ( $@ =~ /Can't locate $module/ ) {
+
+# this could be a subclass so try to load the parent class
+# is this used?
+ next if $module =~ s{/\w+\.pm$}{.pm} ;
+
+ die
+ "Conf: can't find module for class $class" ;
+ }
+
+ return "eval $@\n" if $@ ;
+ }
+
+ }
+
+# if arguments, call the method or new to get a possible object
+
+ if ( my $args_ref = $conf{'args'} ) {
+
+ my @args ;
+
+ if ( ref $args_ref eq 'HASH' ) {
+
+ @args = %{$args_ref} ;
+ }
+ elsif ( ref $args_ref eq 'ARRAY' ) {
+
+ @args = @{$args_ref} ;
+ }
+ else {
+ return
+ "args entry is not an HASH or ARRAY ref\n" .
+ Dumper($args_ref). "\n" ;
+ }
+
+ my $method = $conf{'method'} || 'new' ;
+
+
+# register if we have an object
+
+#print "NAME: $reg_name\n" ;
+
+ if ( my $obj = $class->$method(
+ 'reg_name' => $reg_name,
+ @args ) ) {
+
+ return <<ERR unless ref $obj ;
+Configure error in Cell '$reg_name' from class '$class'
+$obj
+ERR
+
+# register the object by the conf name or the class
+
+ my $err = Stem::Route::register_cell(
+ $obj,
+ $reg_name || $class ) ;
+
+ return $err if $err ;
+ push @notify_done, $obj if $obj->can('config_done');
+ next;
+ }
+
+ }
+# or else register the class if we have a name
+
+ my $err = Stem::Route::register_class( $class, $reg_name ) ;
+
+ return $err if $err ;
+ push @notify_done, $class if $class->can('config_done');
+ }
+
+ foreach my $class (@notify_done) {
+ $class->config_done();
+ }
+
+ return ;
+}
+
+1 ;
--- /dev/null
+# File: Stem/Console.pm
+
+# This file is part of Stem.
+# Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
+
+# Stem is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# Stem is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with Stem; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# For a license to use the Stem under conditions other than those
+# described here, to purchase support for this software, or to purchase a
+# commercial warranty contract, please contact Stem Systems at:
+
+# Stem Systems, Inc. 781-643-7504
+# 79 Everett St. info@stemsystems.com
+# Arlington, MA 02474
+# USA
+
+package Stem::Console ;
+
+use Stem::Trace 'log' => 'stem_status', 'sub' => 'TraceStatus' ;
+use Stem::Trace 'log' => 'stem_error' , 'sub' => 'TraceError' ;
+
+use strict ;
+
+use Data::Dumper ;
+use Symbol ;
+use Socket ;
+
+use Stem::AsyncIO ;
+use Stem::Vars ;
+
+my $console_obj ;
+my $line ;
+
+my( $read_fh, $write_fh, $parent_fh, $child_fh ) ;
+
+if ( $^O =~ /Win32/ ) {
+
+
+ $parent_fh = gensym ;
+ $child_fh = gensym ;
+
+ socketpair( $parent_fh, $child_fh, AF_UNIX, SOCK_STREAM, PF_UNSPEC ) ;
+ start_reader() ;
+ start_writer() ;
+
+# close $child_fh ;
+
+ $read_fh = $parent_fh ;
+ $write_fh = $parent_fh ;
+}
+else {
+
+ $read_fh = \*STDIN ;
+ $write_fh = \*STDOUT ;
+}
+
+return init() unless $Env{'console_disable'} || $Env{'tty_disable'} ;
+
+
+sub start_reader {
+
+# back to parent
+
+ return if fork() ;
+
+ close $parent_fh ;
+
+#syswrite( \*STDERR, "reader started\n" ) ;
+#warn "reader started2\n" ;
+
+ while( 1 ) {
+
+ my $buf ;
+
+ my $cnt = sysread( \*STDIN, $buf, 1000 ) ;
+
+#syswrite( \*STDERR, $buf ) ;
+
+ syswrite( $child_fh, $buf ) ;
+ }
+}
+
+sub start_writer {
+
+# back to parent
+
+ return if fork() ;
+
+# close $parent_fh ;
+
+ while( 1 ) {
+
+ my $buf ;
+
+ my $cnt = sysread( $child_fh, $buf, 1000 ) ;
+
+ syswrite( \*STDOUT, $buf ) ;
+ }
+}
+
+sub init {
+
+ Stem::Route::register_class( __PACKAGE__, 'cons', 'console', 'tty' ) ;
+
+ $Env{'has_console'} = 1 ;
+
+ my $self = bless {} ;
+
+ my $aio = Stem::AsyncIO->new(
+
+ 'object' => $self,
+ 'read_fh' => $read_fh,
+ 'write_fh' => $write_fh,
+ 'read_method' => 'stdin_read',
+ 'closed_method' => 'stdin_closed',
+ ) ;
+
+ return $aio unless ref $aio ;
+
+ $self->{'aio'} = $aio ;
+
+ $self->{'prompt'} = $Env{'prompt'} || "\nStem > " ;
+
+ $console_obj = $self ;
+
+ $self->write( "\nEnter 'help' for help\n\n" ) ;
+ $self->prompt() ;
+
+ return 1 ;
+}
+
+sub stdin_read {
+
+ my( $self, $line_ref ) = @_ ;
+
+ $line = ${$line_ref} ;
+
+ chomp( $line ) ;
+
+ if ( $line =~ /^\s*$/ ) {
+
+ $self->prompt() ;
+ return ;
+ }
+
+ if ( $line =~ /^quit\s*$/i ) {
+
+ TraceStatus "quitting" ;
+
+ exit ;
+ }
+
+ if ( $line =~ /^\s*help\s*$/i ) {
+
+ $self->help() ;
+ $self->prompt() ;
+ return ;
+ }
+
+ if ( my( $key, $val ) = $line =~ /^\s*(\w+)\s*=\s*(.+)$/ ) {
+
+ $val =~ s/\s+$// ;
+
+ $self->echo() ;
+
+ $self->write( "Setting Environment '$key' to '$val'\n" ) ;
+ $Env{ $key } = $val ;
+
+ $self->prompt() ;
+
+ return ;
+ }
+
+ unless ( $line =~ /^\s*(\S+)\s+(.*)$/ ) {
+
+ $self->write( <<ERR ) ;
+Console commands must be in the form
+<Cell Address> command [args ...]
+
+ERR
+ $self->prompt() ;
+
+ return ;
+ }
+
+ my $addr = $1 ;
+
+ my( $cmd_name, $cmd_data ) = split( ' ', $2, 2 ) ;
+
+# allow a leading : on the command to make it a regular message instead
+
+ my $msg_type = ( $cmd_name =~ s/^:// ) ? 'type' : 'cmd' ;
+
+ my $msg = Stem::Msg->new(
+ 'to' => $addr,
+ 'from' => 'console',
+ $msg_type => $cmd_name,
+ 'data' => \$cmd_data,
+ ) ;
+
+ if( ref $msg ) {
+
+ $self->echo() ;
+
+ $msg->dispatch() ;
+ }
+ else {
+ $self->write( "Bad console command message: $msg\n" ) ;
+ }
+
+ $self->prompt() ;
+
+ return ;
+}
+
+sub stdin_closed {
+
+ my( $self ) = @_ ;
+
+ *STDIN->clearerr() ;
+
+ $self->write( "EOF (ignored)\n" ) ;
+
+ $self->prompt() ;
+}
+
+sub data_in {
+
+ goto &response_in ;
+}
+
+sub response_in {
+
+ my( $self, $msg ) = @_ ;
+
+ $self = $console_obj unless ref $self ;
+
+ return unless $self ;
+
+ my $data = $msg->data() ;
+
+ $self->write( "\n\n" ) ;
+
+ if ( $Env{'console_from'} ) {
+
+ my $from = $msg->from() ;
+
+ $self->write( "[From: $from]\n" ) ;
+ }
+
+ if ( ref $data eq 'SCALAR' ) {
+
+ $self->write( ${$data} ) ;
+ }
+ elsif( ref $data ) {
+
+ $self->write( Dumper( $data ) ) ;
+ }
+ else {
+
+ $self->write( $data ) ;
+ }
+
+ $self->prompt() ;
+}
+
+sub write {
+
+ my( $self, $text ) = @_ ;
+
+ $self = $console_obj unless ref $self ;
+
+ $self->{'aio'}->write( $text ) ;
+}
+
+
+sub prompt {
+
+ my( $self ) = @_ ;
+
+ return unless $self->{'prompt'} ;
+
+ $self->write( $self->{'prompt'} ) ;
+}
+
+sub echo {
+
+ my( $self ) = @_ ;
+
+ return unless $Env{'console_echo'} ;
+
+ $self->write( "->$line\n" ) ;
+}
+
+sub help {
+
+ my( $self ) = @_ ;
+
+ $self->write( <<HELP ) ;
+
+Stem::Console Help:
+
+You can enter various commands to Stem here.
+
+If the line is of the form:
+
+key=value
+
+then the global command args hash %Stem::Vars::Env has that key set to
+the value. Stem environment variables can be used to control log filters,
+set cell behavior, set default values for cell attributes and other purposes
+
+If the line is of the form:
+
+address cmd data_text
+
+it is parsed and a command message is created and sent.
+
+The address can be in one of these forms:
+
+ cell
+ hub:cell
+ hub:cell:target
+ :cell:target
+
+The cmd token is the name of the command for the message. If it is
+prefixed with a :, then this string becomes the message type instead.
+
+The rest of the line is sent as the data of the message.
+
+Examples:
+
+reg status
+
+will send a 'status' command message to the 'reg' cell which is the
+Stem::Route class. A listing of all registered Cells will be returned
+and printed.
+
+server:sw map a c d
+
+That will send a 'map' command message to the Cell named 'sw' in the
+Hub named 'server'. The data will be the string 'a c d'. That is used
+to change the mapping of target 'a' to c, d in the Switch Cell in the
+chat and chat2 demos.
+
+HELP
+
+}
+
+1 ;
--- /dev/null
+# File: Stem/Cron.pm
+
+# This file is part of Stem.
+# Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
+
+# Stem is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# Stem is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with Stem; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# For a license to use the Stem under conditions other than those
+# described here, to purchase support for this software, or to purchase a
+# commercial warranty contract, please contact Stem Systems at:
+
+# Stem Systems, Inc. 781-643-7504
+# 79 Everett St. info@stemsystems.com
+# Arlington, MA 02474
+# USA
+
+package Stem::Cron ;
+
+use strict ;
+use Data::Dumper ;
+
+use Stem::Vars ;
+use Stem::Trace 'log' => 'stem_status', 'sub' => 'TraceStatus' ;
+use Stem::Trace 'log' => 'stem_error' , 'sub' => 'TraceError' ;
+
+Stem::Route::register_class( __PACKAGE__, 'cron' ) ;
+
+my %cron_entries ;
+my $cron_timer ;
+my $last_time ;
+
+
+my @set_names = qw( minutes hours month_days months week_days ) ;
+
+{
+ my $t = time ;
+
+ my $interval = 60 ;
+ my $delay = 59 - $t % 60 ;
+
+ if ( $Env{ 'cron_interval' } ) {
+
+ $interval = $Env{ 'cron_interval' } ;
+ $delay = 0 ;
+ }
+
+# my $lt = localtime $t ;
+# print "$t $lt ", $t % 60, "\n" ;
+
+ $cron_timer = Stem::Event::Timer->new(
+ 'object' => __PACKAGE__,
+ 'method' => 'cron_triggered',
+ 'interval' => $interval,
+ 'delay' => $delay,
+ 'repeat' => 1,
+ 'hard' => 1,
+ ) ;
+}
+
+die "Stem::Cron $cron_timer" unless ref $cron_timer ;
+
+
+my $attr_spec = [
+ {
+ 'name' => 'reg_name',
+ 'help' => <<HELP,
+HELP
+ },
+
+ {
+ 'name' => 'msg',
+ 'class' => 'Stem::Msg',
+ 'required' => 1,
+ 'help' => <<HELP,
+HELP
+ },
+
+ {
+ 'name' => 'minutes',
+ 'help' => <<HELP,
+HELP
+ },
+
+ {
+ 'name' => 'hours',
+ 'help' => <<HELP,
+HELP
+ },
+
+ {
+ 'name' => 'month_days',
+ 'help' => <<HELP,
+HELP
+ },
+
+ {
+ 'name' => 'months',
+ 'help' => <<HELP,
+HELP
+ },
+
+ {
+ 'name' => 'week_days',
+ 'help' => <<HELP,
+HELP
+ },
+
+] ;
+
+my %ranges = (
+
+ 'minutes' => [0, 59],
+ 'hours' => [0, 23],
+ 'month_days' => [1, 31],
+ 'months' => [1, 12],
+ 'week_days' => [0, 6],
+) ;
+
+
+sub new {
+
+ my( $class ) = shift ;
+
+ my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
+ return $self unless ref $self ;
+
+ $self->{'msg'}->from_cell( $self->{'reg_name'} || 'cron' ) ;
+
+# make sets for each time part. if one isn't created because it is
+# empty, it is a wild card with behaves as if all the slots are set.
+
+ foreach my $set_name ( @set_names ) {
+
+ $self->_make_cron_set( $set_name, @{$ranges{$set_name}} )
+ }
+
+# keep track of all the active cron entries.
+
+ $cron_entries{ $self } = $self ;
+
+ TraceStatus Dumper($self) ;
+
+####################
+####################
+# why return cron entry? it should not be registered as you can't send
+# it messages. do we need a way to cancel a cron entry? could we
+# register in internally to cron and not need external registration?
+####################
+####################
+
+ return $self ;
+}
+
+sub _make_cron_set {
+
+ my( $self, $set_name, $min, $max ) = @_ ;
+
+ my $cron_list = $self->{$set_name} ;
+
+ return unless ref $cron_list eq 'ARRAY' ;
+
+ my( @cron_vals ) ;
+
+ foreach my $cron_val ( @{$cron_list} ) {
+
+ if ( $cron_val =~ /^(\d+)$/ &&
+ $min <= $1 && $1 <= $max ) {
+
+ push @cron_vals, $1 ;
+ next ;
+ }
+
+ if ( $cron_val =~ /^(\d+)-(\d+)$/ &&
+ $min <= $1 && $1 <= $2 && $2 <= $max ) {
+
+ push @cron_vals, $1 .. $2 ;
+ next ;
+ }
+
+##################
+##################
+##################
+# this is for normal cron entries with names like days of week and
+# months. the name translation tables will be passed in or defaulted
+# to american names. it needs work.
+#
+# also to be done is fancy entries like first thursday of month or
+# weekend days, etc. it will be a filter to run when the numeric days
+# of week or month days filter is run.
+##################
+##################
+##################
+
+# if ( $convert_to_num &&
+# exists( $convert_to_num->{$cron_val} ) ) {
+
+# push @cron_vals, $convert_to_num->{$cron_val} ;
+# next ;
+# }
+
+ TraceError "bad cron value '$cron_val'" ;
+ }
+
+ if ( @cron_vals ) {
+
+ my @cron_set ;
+
+ @cron_set[@cron_vals] = (1) x @cron_vals ;
+
+ $self->{"${set_name}_set"} = \@cron_set ;
+ }
+}
+
+
+sub cron_triggered {
+
+ my $this_time = time() ;
+
+ my %set_times ;
+
+ TraceStatus scalar localtime( $this_time ) ;
+
+# get the current time part into a hash
+
+ @set_times{ @set_names } = (localtime( $this_time ))[ 1, 2, 3, 4, 6 ] ;
+
+# one base the months
+
+ $set_times{'months'}++ ;
+
+ my( $set ) ;
+
+# loop over all the entries
+
+ CRON:
+ foreach my $cron ( values %cron_entries ) {
+
+# loop over all the possible time sets
+
+ foreach my $name ( @set_names ) {
+
+# my $s = $cron->{"${name}_set"} || [] ;
+# print "C $name $set_times{ $name } @$s\n" ;
+
+# we don't trigger unless we have a set with data and the time slot
+# for the current time is true
+
+ next CRON if $set = $cron->{"${name}_set"} and
+ ! $set->[$set_times{ $name }] ;
+ }
+
+#print "C disp $cron\n" ;
+
+# we must have passed all the time filters, so send the message
+
+ $cron->{'msg'}->dispatch() ;
+ }
+}
+
+sub status_cmd {
+
+Dumper(\%cron_entries) ;
+
+}
+
+1 ;
--- /dev/null
+# File: Stem/DBI.pm
+
+# This file is part of Stem.
+# Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
+
+# Stem is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# Stem is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with Stem; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# For a license to use the Stem under conditions other than those
+# described here, to purchase support for this software, or to purchase a
+# commercial warranty contract, please contact Stem Systems at:
+
+# Stem Systems, Inc. 781-643-7504
+# 79 Everett St. info@stemsystems.com
+# Arlington, MA 02474
+# USA
+
+package Stem::DBI ;
+
+use strict ;
+
+use DBI ;
+
+use base 'Stem::Cell' ;
+use Stem::Route qw( :cell ) ;
+
+
+my $attr_spec = [
+
+ {
+ 'name' => 'reg_name',
+ 'help' => <<HELP,
+HELP
+ },
+
+ {
+ 'name' => 'port',
+ 'help' => <<HELP,
+HELP
+ },
+
+ {
+ 'name' => 'host',
+ 'help' => <<HELP,
+HELP
+ },
+
+ {
+ 'name' => 'db_type',
+ 'required' => 1,
+ 'help' => <<HELP,
+HELP
+ },
+
+ # db_name must be something that can go after "dbi:mysql:" so
+ # something like "dbname=foo" or "database=foo" depending on
+ # the driver.
+ {
+ 'name' => 'db_name',
+ 'required' => 1,
+ 'help' => <<HELP,
+HELP
+ },
+
+ {
+ 'name' => 'user_name',
+ 'env' => 'dbi_user_name',
+ 'help' => <<HELP,
+HELP
+ },
+
+ {
+ 'name' => 'password',
+ 'env' => 'dbi_password',
+ 'help' => <<HELP,
+HELP
+ },
+
+ {
+ 'name' => 'dsn_extras',
+ 'help' => <<HELP,
+HELP
+ },
+
+ {
+ 'name' => 'statements',
+ 'help' => <<HELP,
+HELP
+ },
+ {
+ 'name' => 'error_log',
+ 'help' => <<HELP,
+HELP
+ },
+
+ {
+ 'name' => 'default_return_type',
+ 'default' => 'list_of_hashes',
+ 'help' => <<HELP,
+HELP
+ },
+ {
+ 'name' => 'cell_attr',
+ 'class' => 'Stem::Cell',
+ 'help' => <<HELP,
+This value is the attributes for the included Stem::Cell which handles
+cloning, async I/O and pipes.
+HELP
+ },
+] ;
+
+
+sub new {
+
+ my( $class ) = shift ;
+
+ my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
+ return $self unless ref $self ;
+
+ return "statements is not an ARRAY ref"
+ unless ref $self->{'statements'} eq 'ARRAY' ;
+
+ if ( my $err = $self->db_connect() ) {
+
+ return $err ;
+ }
+
+ if ( my $err = $self->prepare() ) {
+
+ return $err ;
+ }
+
+ $self->cell_worker_ready() ;
+
+ return $self ;
+}
+
+sub db_connect {
+
+ my ( $self ) = @_ ;
+
+ my $db_type = $self->{'db_type'} ;
+ my $db_name = $self->{'db_name'} ;
+ my $host = $self->{'host'} ;
+ my $port = $self->{'port'} ;
+ my $user_name = $self->{'user_name'} ;
+ my $password = $self->{'password'} ;
+ my $extras = $self->{'dsn_extras'} ;
+
+ my $dsn = "dbi:$db_type:$db_name" ;
+ $dsn .= ";host=$host" if defined $host ;
+ $dsn .= ";port=$port" if defined $port ;
+ $dsn .= ";$extras" if defined $extras ;
+
+#print "DSN [$dsn]\n" ;
+ my $dbh = DBI->connect( $dsn, $user_name, $password,
+ { 'PrintError' => 0,
+ 'FetchHashKeyName' => 'NAME_lc' } )
+ or return DBI->errstr ;
+
+ $self->{'dbh'} = $dbh ;
+
+ return ;
+}
+
+
+sub prepare {
+
+ my ( $self ) = @_ ;
+
+ my %name2statement ;
+
+ my $dbh = $self->{'dbh'} ;
+
+ my $statements = $self->{'statements'} ;
+
+ foreach my $statement ( @{$statements} ) {
+
+ # Hey, this is ugly. I guess we need parameter type
+ # coercion ;)
+ $statement = { @{$statement} };
+ my $name = $statement->{'name'} ;
+
+ return "statement is missing a name" unless $name ;
+
+ my $sql = $statement->{'sql'} ;
+
+ return "statement '$name' is missing sql" unless defined $sql ;
+
+ $statement->{'return_type'} ||= $self->{'default_return_type'};
+
+ unless ( $self->can( $statement->{'return_type'} ) ) {
+
+ return
+ "No such return type for $name: $statement->{'return_type'}";
+ }
+
+ my $sth = $dbh->prepare( $sql )
+ or return $dbh->errstr ;
+
+ $statement->{'sth'} = $sth ;
+
+ $name2statement{ $name } = $statement ;
+ }
+
+ $self->{'name2statement'} = \%name2statement ;
+
+ return ;
+}
+
+sub execute_cmd {
+
+ my( $self, $msg ) = @_ ;
+
+#print "EXEC\n" ;
+
+# why not tell the queue ready before we start this operation. since
+# it blocks we will handle that new work until this is done.
+
+ $self->cell_worker_ready() ;
+
+ my $data = $msg->data() ;
+
+ return $self->log_error( "No message data" )
+ unless $data ;
+ return $self->log_error( "Message data is not a hash " )
+ unless ref $data eq 'HASH' ;
+
+ my $sth ;
+ my $statement ;
+
+ if ( exists $data->{'sql'} ) {
+
+ return "Must provide return type" unless exists $data->{'return_type'} ;
+
+ $statement = $data->{'sql'} ;
+
+ $sth = $self->{'dbh'}->prepare( $statement ) ;
+
+ return $self->log_error( $self->{'dbh'}->errstr . "\n$statement" )
+ if $self->{'dbh'}->errstr ;
+ }
+ else {
+
+ $statement = $data->{'statement'} ;
+
+ if ( my $in_cnt = $data->{'in_cnt'} ) {
+
+ my $sql = $self->{'name2statement'}{$statement}{'sql'} ;
+
+ my @qmarks = ('?') x $in_cnt ;
+ local( $" ) = ',' ;
+ $sql =~ s/IN\(\)/IN( @qmarks )/i ;
+
+ $sth = $self->{'dbh'}->prepare( $sql ) ;
+
+ return $self->log_error(
+ $self->{'dbh'}->errstr . "\n$statement" )
+ if $self->{'dbh'}->errstr ;
+ }
+ else {
+
+ $sth = $self->{'name2statement'}{$statement}{'sth'} ;
+ return $self->log_error(
+ "Unknown statement name: $statement" ) unless $sth ;
+ }
+ }
+
+
+ $self->{'statement'} = $statement ;
+
+ my $bind = $data->{'bind'} || [] ;
+ return $self->log_error( "Statement arguments are not a list " )
+ unless ref $bind eq 'ARRAY' ;
+
+ my $dbh = $self->{'dbh'} ;
+
+ my $return_type = $data->{'return_type'} ||
+ $self->{'name2statement'}{$statement}{'return_type'} ;
+
+ unless ( $self->can( $return_type ) ) {
+
+ return $self->log_error(
+ "No such return type: $data->{'return_type'}" ) ;
+ }
+
+ my $dbi_result = $self->$return_type( $sth, $bind ) ;
+
+ if ( $dbi_result && ! ref $dbi_result ) {
+
+ return( $self->log_error( "[$statement] $dbi_result" ) ) ;
+ }
+
+ return $dbi_result ;
+}
+
+sub list_of_hashes {
+
+ return shift->_fetch( 'fetchall_arrayref', @_, {} );
+}
+
+sub list_of_arrays {
+
+ return shift->_fetch( 'fetchall_arrayref', @_, [] );
+}
+
+sub one_hashref {
+
+ return shift->_fetch( 'fetchrow_hashref', @_ );
+}
+
+sub column_as_array {
+
+ my( $self, $sth, $bind ) = @_;
+
+ my @column;
+
+ $sth->finish if $sth->{'Active'} ;
+
+ $sth->execute( @{$bind} ) or return $sth->errstr ;
+
+ while ( my @row = $sth->fetchrow_array ) {
+
+ push @column, $row[0];
+ }
+
+ return $sth->errstr() if $sth->errstr() ;
+
+ return \@column;
+}
+
+sub _fetch {
+
+ my( $self, $method, $sth, $bind, @args ) = @_ ;
+
+ $sth->finish if $sth->{'Active'} ;
+
+ $sth->execute( @{$bind} ) or return $sth->errstr ;
+
+ my $data = $sth->$method( @args ) ;
+
+ return $sth->errstr if $sth->errstr ;
+
+ return $data ;
+}
+
+sub rows_affected {
+
+ my( $self, $sth, $bind ) = @_;
+
+ $sth->execute( @{$bind} );
+
+ return $sth->errstr if $sth->errstr ;
+
+ return { 'rows' => $sth->rows };
+}
+
+sub insert_id {
+
+ my( $self, $sth, $bind ) = @_;
+
+ my $err = $sth->execute( @{$bind} );
+
+ return $sth->errstr if $sth->errstr ;
+
+#print "ID: [$self->{'dbh'}{'mysql_insertid'}]\n" ;
+
+ return { 'insert_id' => $self->{'dbh'}{'mysql_insertid'} } ;
+}
+
+sub log_error {
+
+ my ( $self, $err ) = @_;
+
+ my $log = $self->{'error_log'} ;
+
+ return $err unless $log ;
+
+ Stem::Log::Entry->new (
+ 'logs' => $log,
+ 'level' => 5,
+ 'label' => 'Stem::DBI',
+ 'text' => "Statement: $self->{'statement'} - $err\n",
+ ) ;
+
+ return \$err ;
+}
+
+1 ;
--- /dev/null
+#!/usr/local/bin/perl
+
+package Stem::Debug ;
+
+use strict ;
+use Data::Dumper ;
+use Scalar::Util qw( openhandle ) ;
+
+use base 'Exporter' ;
+our @EXPORT_OK = qw ( dump_data dump_socket dump_owner ) ;
+
+sub dump_data {
+
+ my( $data ) = @_ ;
+
+ local $Data::Dumper::Sortkeys = \&dump_filter ;
+
+ return Dumper $data ;
+}
+
+sub dump_filter {
+
+ my( $href ) = @_ ;
+
+ my @keys ;
+
+ my %fh_dumps ;
+
+ while( my( $key, $val ) = each %{$href} ) {
+
+ if( my $fh_val = dump_socket( $val ) ) {
+
+ my $fh_key = "$key.FH" ;
+ $fh_dumps{$fh_key} = $fh_val ;
+ push @keys, $fh_key ;
+ next ;
+ }
+
+ push @keys, $key ;
+ }
+
+ @{$href}{ keys %{fh_dumps} } = values %{fh_dumps} ;
+
+#print "KEYS [@keys]\n" ;
+
+ return [ sort @keys ] ;
+}
+
+sub dump_socket {
+
+ my ( $sock ) = @_ ;
+
+ return 'UNDEF' unless defined $sock ;
+ return 'EMPTY' unless $sock ;
+ return 'NOT REF' unless ref $sock ;
+
+ return 'NOT GLOB' unless $sock =~ /GLOB/ ;
+
+warn "SOCK [$sock]\n" ;
+
+ my $fdnum = fileno( $sock ) ;
+
+ return 'NO FD' unless defined $fdnum ;
+
+ my $opened = openhandle( $sock ) ? 'OPEN' : 'CLOSED' ;
+
+# return "CLOSED $sock" if $opened eq 'CLOSED' ;
+
+# $fdnum = 'NONE' unless defined $fdnum ;
+
+# my $fdnum = "FOO" ;
+
+# return "FD [$fdnum]" unless $sock->isa('IO::Socket') ;
+
+ return "FD [$fdnum] *$opened* $sock" ;
+}
+
+
+
+sub dump_owner {
+
+ my ( $owner ) = @_ ;
+
+ my $owner_dump = "$owner" ;
+
+ while( $owner->{object} ) {
+
+ $owner = $owner->{object} ;
+ $owner_dump .= " -> $owner " ;
+ }
+
+ return $owner_dump ;
+}
+
+1 ;
--- /dev/null
+package Stem::Demo::CLI ;
+
+print "LOAD\n" ;
+
+use strict;
+
+use base 'Stem::Cell' ;
+
+my $attr_spec = [
+ {
+ name => 'reg_name',
+ help => <<HELP,
+Name this Cell was registered with.
+HELP
+ },
+ {
+ name => 'cell_attr',
+ class => 'Stem::Cell',
+ help => <<HELP,
+This value is the attributes for the included Stem::Cell which handles
+cloning and sequencing.
+HELP
+ },
+];
+
+sub new {
+
+ my( $class ) = shift ;
+#print "ARGS [@_]\n" ;
+ my $self = Stem::Class::parse_args( $attr_spec, @_ );
+ return $self unless ref $self;
+
+ return $self ;
+}
+
+sub triggered_cell {
+
+ my( $self ) = @_ ;
+
+print "TRIGGERED\n" ;
+
+ $self->cell_activate;
+
+#print $self->SUPER::_dump( "CLI TRIGGERED\n" ) ;
+
+ return;
+}
+
+my %op_to_code = (
+
+ set => \&_set,
+ get => \&_get,
+ dump => \&_dump,
+ clear => \&_clear,
+ help => \&_help,
+) ;
+
+sub data_in {
+
+ my( $self, $msg ) = @_;
+
+#print $msg->dump( 'IN' ) ;
+
+ $self->{data_in_msg} = $msg ;
+
+ my $data = $msg->data() ;
+
+ my $op = $data->{op} ;
+
+ if( my $code = $op_to_code{ $op } ) {
+
+ $self->$code( $data ) ;
+ }
+ else {
+
+ $self->send_reply( "unknown CLI op '$op'" ) ;
+ }
+}
+
+sub send_reply {
+
+ my ( $self, $data ) = @_;
+
+ my $in_msg = delete $self->{data_in_msg} ;
+
+ my $reply_msg = $in_msg->reply( type => 'data', data => $data ) ;
+
+#print $reply_msg->dump( 'REPLY' ) ;
+
+ $reply_msg->dispatch() ;
+}
+
+sub _set {
+
+ my( $self, $data ) = @_;
+
+ my $key = $data->{key} ;
+ if ( defined( $key ) ) {
+
+ my $value = $data->{value} ;
+
+ $self->{data}{$key} = $value ;
+
+ $self->send_reply( "set '$key' to '$value'" ) ;
+ }
+ else {
+ $self->send_reply( "set is missing a key" ) ;
+ }
+}
+
+sub _get {
+
+ my( $self, $data ) = @_;
+
+ my $key = $data->{key} ;
+ if ( defined( $key ) ) {
+
+ my $value = $self->{data}{$key} ;
+
+ $self->send_reply( "'$key' was set to '$value'" ) ;
+ }
+ else {
+ $self->send_reply( "get is missing a key" ) ;
+ }
+}
+
+sub _clear {
+
+ my( $self ) = @_;
+
+ $self->{data} = {} ;
+ $self->send_reply( "cleared your data" ) ;
+}
+
+sub _dump {
+
+ my( $self ) = @_;
+
+ my $text = join '', map "\t$_ => $self->{data}{$_}\n",
+ sort keys %{$self->{data}} ;
+
+ $self->send_reply( "your data is:\n$text\n" ) ;
+}
+
+sub _help {
+
+ my( $self ) = @_;
+
+ my $text = <<TEXT ;
+
+These are the commands supported in Stem::Demo::CLI
+
+set <name> <value>
+get <name>
+dump
+clear
+help
+
+set sets a value in the CLI session hash
+get gets a value in the CLI session hash
+dump returns a dump of the session hash
+clear will empty the the session hash
+help prints this text
+
+TEXT
+
+ $self->send_reply( $text ) ;
+}
+
+
+1 ;
--- /dev/null
+package Stem::Demo::World ;
+sub hello_cmd { return "Hello World!\n" }
+1 ;
--- /dev/null
+# File: Stem/Event.pm
+
+# This file is part of Stem.
+# Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
+
+# Stem is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# Stem is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with Stem; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# For a license to use the Stem under conditions other than those
+# described here, to purchase support for this software, or to purchase a
+# commercial warranty contract, please contact Stem Systems at:
+
+# Stem Systems, Inc. 781-643-7504
+# 79 Everett St. info@stemsystems.com
+# Arlington, MA 02474
+# USA
+
+# this is the base class for all of the other event classes. it
+# provides common services and also stubs for the internal _methods so
+# the other classes don't need to declare them if they don't use them.
+
+package Stem::Event ;
+
+use Stem::Class ;
+
+use strict ;
+
+# this will hold the hashes of events for each event type.
+
+my %all_events = (
+
+ plain => {},
+ signal => {},
+ timer => {},
+ read => {},
+ write => {},
+) ;
+
+# table of loop types to the Stem::Event::* class name
+
+my %loop_to_class = (
+
+ event => 'EventPM',
+ perl => 'Perl',
+ tk => 'Tk',
+ wx => 'Wx',
+# gtk => 'Gtk',
+# qt => 'Qt',
+) ;
+
+# use the requested event loop and default to perl on windows and
+# event.pm elsewhere.
+
+my $loop_class = _get_loop_class() ;
+
+init_loop() ;
+
+
+sub init_loop {
+
+ $loop_class->_init_loop() ;
+
+Stem::Event::Queue::_init_queue() if defined &Stem::Event::Queue::_init_queue ;
+
+}
+
+sub start_loop {
+
+ $loop_class->_start_loop() ;
+}
+
+sub stop_loop {
+
+ $loop_class->_stop_loop() ;
+}
+
+sub trigger {
+
+ my( $self, $method ) = @_ ;
+
+# never trigger inactive events
+
+ return unless $self->{active} ;
+
+
+ $method ||= $self->{'method'} ;
+#print "METHOD [$method]\n" ;
+
+ $self->{'object'}->$method( $self->{'id'} ) ;
+
+ Stem::Msg::process_queue() if defined &Stem::Msg::process_queue;
+
+ return ;
+}
+
+#################
+# all the stuff below is a rough cell call trace thing. it needs work
+# it would be put inside the trigger method
+# 'log_type' attribute is set or the event type is used.
+#_init subs need to set event_log_type in the object
+#use Stem::Trace 'log' => 'stem_status', 'sub' => 'TraceStatus' ;
+#use Stem::Trace 'log' => 'stem_error' , 'sub' => 'TraceError' ;
+# $log_type = $self->{'log_type'} || $self->{'event_type'} ;
+# TraceStatus "[$log_type] [$object] [$method]\n" ;
+# $Stem::Event::current_object = $object ;
+# my ( $cell_name, $target ) = Stem::Route::lookup_cell_name( $object ) ;
+# if ( $cell_name ) {
+# # Debug
+# # "EVENT $event to $cell_name:$target [$object] [$method]\n" ;
+# }
+# else {
+# # Debug "EVENT $event to [$object] [$method]\n" ;
+# }
+#################
+
+
+# get all the event objects for an event type
+# this is a class sub.
+
+sub _get_events {
+
+ my( $event_type ) = @_ ;
+
+ my $events = $all_events{ $event_type } ;
+
+ return unless $events ;
+
+ return values %{$events} if wantarray ;
+
+ return $events ;
+}
+
+# initialize the subclass object for this event and store generic event
+# info.
+
+sub _build_core_event {
+
+#print "BAZ\n" ;
+
+ my( $self, $event_type ) = @_ ;
+
+
+#print "EVT [$self] [$event_type]\n" ;
+
+# call and and check the return of the core event constructor
+
+ if ( my $core_event = $self->_build() ) {
+
+# return the error if it was an error string
+
+ return $core_event unless ref $core_event ;
+
+# save the core event
+
+ $self->{core_event} = $core_event ;
+ }
+
+# mark the event type and track it
+
+ $self->{event_type} = $event_type ;
+ $all_events{ $event_type }{ $self } = $self ;
+
+ return ;
+}
+
+# these are the public versions of the support methods.
+# subclasses can provide a _method to override the stub ones in this class.
+
+sub cancel {
+
+ my( $self ) = @_ ;
+
+ $self->{'active'} = 0 ;
+ delete $self->{'object'} ;
+
+# delete the core object
+
+ if ( my $core_event = delete $self->{core_event} ) {
+
+ # call the core cancel
+
+ $self->_cancel( $core_event ) ;
+ }
+
+# delete this event from the tracking hash
+
+ delete $all_events{ $self->{event_type} }{ $self } ;
+
+ return ;
+}
+
+sub start {
+ my( $self ) = @_ ;
+
+ $self->{'active'} = 1 ;
+ $self->_start( $self->{core_event} ) ;
+
+ return ;
+}
+
+sub stop {
+ my( $self ) = @_ ;
+
+ $self->{'active'} = 0 ;
+ $self->_stop( $self->{core_event} ) ;
+
+ return ;
+}
+
+# stubs for the internal methods that subclasses should override if needed.
+
+sub _init_loop {}
+sub _build {}
+sub _start {}
+sub _stop {}
+sub _reset {}
+sub _cancel {}
+
+use Stem::Debug qw( dump_socket dump_owner dump_data ) ;
+
+sub dump_events {
+
+ print dump_data( \%all_events ) ;
+}
+
+sub dump {
+
+ my( $self ) = @_ ;
+
+ my $event_text = <<TEXT ;
+EV: $self
+ACT: $self->{'active'}
+TEXT
+
+ my $obj_dump = dump_owner $self->{'object'} ;
+ $event_text .= <<TEXT ;
+OBJ: $obj_dump
+METH: $self->{'method'}
+TEXT
+
+ if ( my $fh = $self->{'fh'} ) {
+
+ my $fh_text = dump_socket( $self->{'fh'} ) ;
+ $event_text .= <<TEXT ;
+FH: $fh_text
+TEXT
+ }
+
+ if ( $self->{event_type} eq 'timer' ) {
+
+ my $delay = $self->{delay} || 'NONE' ;
+ my $interval = $self->{interval} || 'NONE' ;
+ $event_text .= <<TEXT ;
+DELAY: $delay
+INT: $interval
+TEXT
+ }
+
+ if ( my $io_timer_event = $self->{'io_timer_event'} ) {
+
+ $event_text = "IO TIMER: >>>>>\n" . $io_timer_event->dump() .
+ "END\n";
+ }
+
+ return <<DUMP ;
+
+>>>
+$event_text<<<
+
+DUMP
+
+}
+
+#############
+# change this to a cleaner loop style which can handle more event loops and
+# try them in sequence
+#############
+
+sub _get_loop_class {
+
+ my $loop_type = $Stem::Vars::Env{ 'event_loop' } ||
+ ($^O =~ /win32/i ? 'perl' : 'event' );
+
+ $loop_type = 'perl' unless $loop_to_class{ $loop_type } ;
+ my $loop_class = "Stem::Event::$loop_to_class{ $loop_type }" ;
+
+ unless ( eval "require $loop_class" ) {
+ die "can't load $loop_class: $@" if $@ && $@ !~ /locate/ ;
+
+ $loop_type = 'perl' ;
+ eval { require Stem::Event::Perl } ;
+ die "can't load event loop Stem::Event::Perl $@" if $@ ;
+ }
+
+ # save the event loop that we loaded.
+
+ #print "using event loop [$loop_type]\n" ;
+ $Stem::Vars::Env{ 'event_loop' } = $loop_type ;
+
+ return $loop_class ;
+}
+
+
+############################################################################
+
+package Stem::Event::Plain ;
+
+BEGIN {
+ @Stem::Event::Plain::ISA = qw( Stem::Event ) ;
+}
+
+=head2 Stem::Event::Plain::new
+
+This class creates an event that will trigger a callback after all
+other pending events have been triggered.
+
+=head2 Example
+
+ $plain_event = Stem::Event::Plain->new( 'object' => $self ) ;
+
+=cut
+
+my $attr_spec_plain = [
+
+ {
+ 'name' => 'object',
+ 'required' => 1,
+ 'type' => 'object',
+ 'help' => <<HELP,
+This object gets the method callbacks
+HELP
+ },
+ {
+ 'name' => 'method',
+ 'default' => 'triggered',
+ 'help' => <<HELP,
+This method is called on the object when the plain event is triggered
+HELP
+ },
+ {
+ 'name' => 'id',
+ 'help' => <<HELP,
+The id is passed to the callback method as its only argument. Use it to
+identify different instances of this object.
+HELP
+
+ },
+] ;
+
+sub new {
+
+ my( $class ) = shift ;
+
+ my $self = Stem::Class::parse_args( $attr_spec_plain, @_ ) ;
+ return $self unless ref $self ;
+
+ my $err = $self->_core_event_build( 'plain' ) ;
+ return $err if $err ;
+
+ return $self ;
+}
+
+############################################################################
+
+package Stem::Event::Signal ;
+
+BEGIN { our @ISA = qw( Stem::Event ) } ;
+
+=head2 Stem::Event::Signal::new
+
+This class creates an event that will trigger a callback whenever
+its its signal has been received.
+
+=head2 Example
+
+ $signal_event = Stem::Event::Signal->new( 'object' => $self,
+ 'signal' => 'INT' ) ;
+
+ sub sig_int_handler { die "SIGINT\n" }
+
+=cut
+
+my $attr_spec_signal = [
+
+ {
+ 'name' => 'object',
+ 'required' => 1,
+ 'type' => 'object',
+ 'help' => <<HELP,
+This object gets the method callbacks
+HELP
+ },
+ {
+ 'name' => 'method',
+ 'help' => <<HELP,
+This method is called on the object when this event is triggered. The
+default method name for the signal NAME is 'sig_name_handler' (all lower case)
+HELP
+ },
+ {
+ 'name' => 'signal',
+ 'required' => 1,
+ 'help' => <<HELP,
+This is the name of the signal to handle. It is used as part of the
+default handler method name.
+HELP
+ },
+ {
+ 'name' => 'active',
+ 'default' => 1,
+ 'type' => 'boolean',
+ 'help' => <<HELP,
+This flag marks the event as being active. It can be toggled with the
+start/stop methods.
+HELP
+ },
+ {
+ 'name' => 'id',
+ 'help' => <<HELP,
+The id is passed to the callback method as its only argument. Use it to
+identify different instances of this object.
+HELP
+
+ },
+] ;
+
+sub new {
+
+ my( $class ) = shift ;
+
+ my $self = Stem::Class::parse_args( $attr_spec_signal, @_ ) ;
+ return $self unless ref $self ;
+
+ my $signal = uc $self->{'signal'} ;
+
+ return "Unknown signal: $signal" unless exists $SIG{ $signal } ;
+
+ $self->{'method'} ||= "sig_\L${signal}_handler" ;
+ $self->{'signal'} = $signal ;
+
+ my $err = $self->_build_core_event( 'signal' ) ;
+ return $err if $err ;
+
+#print "SELF SIG $self\nPID $$\n" ;
+
+ return $self ;
+}
+
+
+############################################################################
+
+package Stem::Event::Timer ;
+
+BEGIN { our @ISA = qw( Stem::Event ) } ;
+
+=head2 Stem::Event::Timer::new
+
+This class creates an event that will trigger a callback after a time
+period has elapsed. The initial timer delay is set from the 'delay',
+'at' or 'interval' attributes in that order. If the 'interval'
+attribute is not set, the timer will cancel itself after its first
+triggering (it is a one-shot). The 'hard' attribute means that the
+next interval delay starts before the callback to the object is
+made. If a soft timer is selected (hard is 0), the delay starts after
+the callback returns. So the hard timer ignores the time taken by the
+callback and so it is a more accurate timer. The accuracy a soft timer
+is affected by how much time the callback takes.
+
+=head2 Example
+
+ $timer_event = Stem::Event::Timer->new( 'object' => $self,
+ 'delay' => 5,
+ 'interval' => 10 ) ;
+
+ sub timed_out { print "timer alert\n" } ;
+
+
+=cut
+
+BEGIN {
+
+my $attr_spec_timer = [
+
+ {
+ 'name' => 'object',
+ 'required' => 1,
+ 'type' => 'object',
+ 'help' => <<HELP,
+This object gets the method callbacks
+HELP
+ },
+ {
+ 'name' => 'method',
+ 'default' => 'timed_out',
+ 'help' => <<HELP,
+This method is called on the object when the timeout is triggered
+HELP
+ },
+ {
+ 'name' => 'delay',
+ 'help' => <<HELP,
+Delay this amount of seconds before triggering the first time. If this
+is not set then the 'at' or 'interval' attributes will be used.
+HELP
+ },
+ {
+ 'name' => 'interval',
+ 'help' => <<HELP,
+Wait this time (in seconds) before any repeated triggers. If not set
+then the timer is a one-shot
+HELP
+ },
+ {
+ 'name' => 'at',
+ 'help' => <<HELP,
+Trigger in the future at this time (in epoch seconds). It will set the intial
+delay to the different between the current time and the 'at' time.
+HELP
+ },
+ {
+ 'name' => 'hard',
+ 'type' => 'boolean',
+ 'default' => 0,
+ 'help' => <<HELP,
+If this is set, the interval time starts when the event is
+triggered. If it is not set, the interval time starts when the object
+callback has finished. So 'hard' timers repeat closer to equal
+intervals while without 'hard' the repeat time is dependant on how
+long the callback takes.
+HELP
+ },
+ {
+ 'name' => 'active',
+ 'default' => 1,
+ 'type' => 'boolean',
+ 'help' => <<HELP,
+This flag marks the event as being active. It can be toggled with the
+start/stop methods.
+HELP
+ },
+ {
+ 'name' => 'id',
+ 'help' => <<HELP,
+The id is passed to the callback method as its only argument. Use it to
+identify different instances of this object.
+HELP
+
+ },
+] ;
+
+sub new {
+
+ my( $class ) = shift ;
+
+ my $self = Stem::Class::parse_args( $attr_spec_timer, @_ ) ;
+ return $self unless ref $self ;
+
+# the delay is either set, or at a future time or the interval
+
+ my $delay = exists( $self->{ 'delay' } ) ?
+ $self->{ 'delay' } :
+ exists( $self->{ 'at' } ) ?
+ $self->{ 'at' } - time() :
+ $self->{'interval'} ;
+
+#print "INT $self->{'interval'} DELAY $delay\n" ;
+
+# squawk if no delay value
+
+ return "No initial delay was specified for timer"
+ unless defined $delay ;
+
+ $self->{'delay'} = $delay ;
+ $self->{'time_left'} = $delay ;
+
+ my $err = $self->_build_core_event( 'timer' ) ;
+ return $err if $err ;
+
+##########
+# check on this logic
+#########
+
+ $self->_stop unless $self->{'active'} ;
+
+ return $self ;
+}
+
+}
+
+sub reset {
+
+ my( $self, $reset_delay ) = @_ ;
+
+ return unless $self->{'active'} ;
+
+# if we don't get passed a delay, use the interval or the delay attribute
+
+ $reset_delay ||= ($self->{'interval'}) ?
+ $self->{'interval'} : $self->{'delay'} ;
+
+# track the new delay and reset the real timer (if we are using one)
+
+ $self->{'time_left'} = $reset_delay ;
+
+ $self->_reset( $self->{core_event}, $reset_delay ) ;
+
+ return ;
+}
+
+sub timer_triggered {
+
+ my( $self ) = @_ ;
+
+#print time(), " TIMER TRIG\n" ;
+#use Carp qw( cluck ) ;
+#cluck ;
+
+# check if this is a one-shot timer
+
+ $self->cancel() unless $self->{'interval'} ;
+
+# reset the timer count before the trigger code for hard timers
+#(trigger on fixed intervals)
+
+ $self->reset( $self->{'interval'} ) if $self->{'hard'};
+
+ $self->trigger() ;
+
+# reset the timer count before the trigger code for soft timers
+#(trigger on at least fixed intervals)
+
+ $self->reset( $self->{'interval'} ) unless $self->{'hard'};
+}
+
+############################################################################
+
+####################################################################
+# common methods for the Read/Write event classes to handle the optional
+# I/O timeouts.
+# these override Stem::Event's methods and then call those via SUPER::
+
+package Stem::Event::IO ;
+
+BEGIN { our @ISA = qw( Stem::Event ) } ;
+
+sub init_io_timeout {
+
+ my( $self ) = @_ ;
+
+ my $timeout = $self->{'timeout'} ;
+ return unless $timeout ;
+
+ $self->{'io_timer_event'} = Stem::Event::Timer->new(
+ 'object' => $self,
+ 'interval' => $timeout,
+ ) ;
+
+ return ;
+}
+
+sub cancel {
+
+ my( $self ) = @_ ;
+
+#print "IO CANCEL $self\n" ;
+
+ if ( my $io_timer_event = delete $self->{'io_timer_event'} ) {
+ $io_timer_event->cancel() ;
+ }
+
+ $self->SUPER::cancel() ;
+
+ delete $self->{'fh'} ;
+
+ return ;
+}
+
+sub start {
+
+ my( $self ) = @_ ;
+
+ if ( my $io_timer_event = $self->{'io_timer_event'} ) {
+ $io_timer_event->start() ;
+ }
+
+ $self->SUPER::start() ;
+
+ return ;
+}
+
+sub stop {
+
+ my( $self ) = @_ ;
+
+ $self->{'active'} = 0 ;
+
+ if ( my $io_timer_event = $self->{'io_timer_event'} ) {
+ $io_timer_event->stop() ;
+ }
+
+ $self->SUPER::stop() ;
+
+ return ;
+}
+
+sub timed_out {
+
+ my( $self ) = @_ ;
+
+# $self->{log_type} = "$self->{'event_type'}_timeout" ;
+ $self->trigger( $self->{'timeout_method'} ) ;
+}
+
+#######################################################
+
+package Stem::Event::Read ;
+
+BEGIN { our @ISA = qw( Stem::Event::IO ) }
+
+=head2 Stem::Event::Read::new
+
+This class creates an event that will trigger a callback whenever
+its file descriptor has data to be read. It takes an optional timeout
+value which will trigger a callback to the object if no data has been
+read during that period.
+
+Read events are active when created - a call to the stop method is
+needed to deactivate them.
+
+=cut
+
+BEGIN {
+
+my $attr_spec_read = [
+
+ {
+ 'name' => 'object',
+ 'required' => 1,
+ 'type' => 'object',
+ 'help' => <<HELP,
+This object gets the method callbacks
+HELP
+ },
+ {
+ 'name' => 'fh',
+ 'required' => 1,
+ 'type' => 'handle',
+ 'help' => <<HELP,
+This file handle is checked if it has data to read
+HELP
+ },
+ {
+ 'name' => 'timeout',
+ 'help' => <<HELP,
+How long to wait (in seconds) without being readable before calling
+the timeout method
+HELP
+ },
+ {
+ 'name' => 'method',
+ 'default' => 'readable',
+ 'help' => <<HELP,
+This method is called on the object when the file handle has data to read
+HELP
+ },
+ {
+ 'name' => 'timeout_method',
+ 'default' => 'read_timeout',
+ 'help' => <<HELP,
+This method is called on the object when the hasn't been readable
+after the timeout period
+HELP
+ },
+ {
+ 'name' => 'active',
+ 'default' => 1,
+ 'type' => 'boolean',
+ 'help' => <<HELP,
+This flag marks the event as being active. It can be toggled with the
+start/stop methods.
+HELP
+ },
+ {
+ 'name' => 'id',
+ 'help' => <<HELP,
+The id is passed to the callback method as its only argument. Use it to
+identify different instances of this object.
+HELP
+
+ },
+] ;
+
+sub new {
+
+ my( $class ) = shift ;
+
+ my $self = Stem::Class::parse_args( $attr_spec_read, @_ ) ;
+ return $self unless ref $self ;
+
+# return <<ERR unless defined fileno $self->{fh} ;
+# Stem::Event::Read: $self->{fh} is not an open handle
+# ERR
+
+ my $err = $self->_build_core_event( 'read' ) ;
+ return $err if $err ;
+
+ $self->init_io_timeout() ;
+
+ return $self ;
+}
+
+}
+############################################################################
+
+package Stem::Event::Write ;
+
+BEGIN { our @ISA = qw( Stem::Event::IO ) } ;
+
+=head2 Stem::Event::Write::new
+
+This class creates an event that will trigger a callback whenever
+its file descriptor can be written to. It takes an optional timeout
+value which will trigger a callback to the object if no data has been
+written during that period.
+
+Write events are stopped when created - a call to the start method is
+needed to activate them.
+
+=cut
+
+my $attr_spec_write = [
+
+ {
+ 'name' => 'object',
+ 'required' => 1,
+ 'type' => 'object',
+ 'help' => <<HELP,
+This object gets the method callbacks
+HELP
+ },
+ {
+ 'name' => 'fh',
+ 'required' => 1,
+ 'type' => 'handle',
+ 'help' => <<HELP,
+This file handle is checked if it is writeable
+HELP
+ },
+ {
+ 'name' => 'timeout',
+ 'help' => <<HELP,
+How long to wait (in seconds) without being writeable before calling
+the timeout method
+HELP
+ },
+ {
+ 'name' => 'method',
+ 'default' => 'writeable',
+ 'help' => <<HELP,
+This method is called on the object when the file handle is writeable
+HELP
+ },
+ {
+ 'name' => 'timeout_method',
+ 'default' => 'write_timeout',
+ 'help' => <<HELP,
+This method is called on the object when the hasn't been writeable
+after the timeout period
+HELP
+ },
+ {
+ 'name' => 'active',
+ 'default' => 0,
+ 'type' => 'boolean',
+ 'help' => <<HELP,
+This flag marks the event as being active. It can be toggled with the
+start/stop methods.
+NOTE: Write events are not active by default.
+HELP
+ },
+ {
+ 'name' => 'id',
+ 'help' => <<HELP,
+The id is passed to the callback method as its only argument. Use it to
+identify different instances of this object.
+HELP
+
+ },
+] ;
+
+sub new {
+
+ my( $class ) = shift ;
+
+ my $self = Stem::Class::parse_args( $attr_spec_write, @_ ) ;
+ return $self unless ref $self ;
+
+ my $err = $self->_build_core_event( 'write' ) ;
+ return $err if $err ;
+
+#print $self->dump_events() ;
+
+ $self->init_io_timeout() ;
+
+ $self->stop() unless $self->{'active'} ;
+
+#print $self->dump() ;
+
+ return $self ;
+}
+
+1 ;
--- /dev/null
+# File: Stem/Event/EventPM.pm
+
+# This file is part of Stem.
+# Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
+
+# Stem is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# Stem is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with Stem; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# For a license to use the Stem under conditions other than those
+# described here, to purchase support for this software, or to purchase a
+# commercial warranty contract, please contact Stem Systems at:
+
+# Stem Systems, Inc. 781-643-7504
+# 79 Everett St. info@stemsystems.com
+# Arlington, MA 02474
+# USA
+
+#print "required" ;
+
+=head1 Stem::Event::EventPM
+
+This module wraps the CPAN module Event.pm for use by the rest of
+Stem. It provides the common API for the standard Stem::Event classes:
+
+=over 4
+
+=item Stem::Event
+=item Stem::Event::Plain
+=item Stem::Event::Timer
+=item Stem::Event::Signal
+=item Stem::Event::Read
+=item Stem::Event::Write
+
+=back
+
+=cut
+
+package Stem::Event::EventPM ;
+
+use strict ;
+use Event ;
+
+@Stem::Event::EventPM::ISA = qw( Stem::Event ) ;
+
+# basic wrappers for top level Event.pm calls.
+
+sub _start_loop {
+ $Event::DIED = \&_died ;
+ Event::loop() ;
+}
+
+sub _died {
+ my( $event, $err ) = @_ ;
+ use Carp;
+ Carp::cluck( "Stem::Event died: $err", "die called in [$event]\n",
+ map( "<$_>", caller() ), "\n" ) ;
+
+ exit;
+} ;
+
+
+sub _stop_loop {
+ Event::unloop_all( 1 ) ;
+}
+
+############################################################################
+
+package Stem::Event::Plain ;
+
+sub _build {
+
+ my( $self ) = @_ ;
+
+# create the plain event watcher
+
+ $self->{'idle_event'} = Event->idle(
+ 'cb' => [ $self, 'idle_triggered' ],
+ 'repeat' => 0
+ ) ;
+
+ return $self ;
+}
+
+sub idle_triggered {
+
+ my( $self ) = @_ ;
+
+ $self->trigger( 'plain' ) ;
+ my $idle_event = delete $self->{'idle_event'} ;
+ $idle_event->cancel() ;
+}
+
+############################################################################
+
+package Stem::Event::Signal ;
+
+sub _build {
+
+ my( $self ) = @_ ;
+
+ my $signal = $self->{'signal'} ;
+
+# create the signal event watcher
+
+ return Event->signal(
+ 'cb' => sub { $self->trigger() },
+ 'signal' => $signal,
+ ) ;
+}
+
+sub _cancel {
+ my( $self, $signal_event ) = @_ ;
+ $signal_event->cancel() ;
+ return ;
+}
+
+############################################################################
+
+package Stem::Event::Timer ;
+
+sub _build {
+
+ my( $self ) = @_ ;
+
+ return Event->timer(
+ 'cb' => [ $self, 'timer_triggered' ],
+ 'hard' => $self->{'hard'},
+ 'after' => $self->{'delay'},
+ 'interval' => $self->{'interval'},
+ ) ;
+}
+
+sub _reset {
+ my( $self, $timer_event, $delay ) = @_ ;
+ $timer_event->again() ;
+ return ;
+}
+
+sub _cancel {
+ my( $self, $timer_event ) = @_ ;
+ $timer_event->cancel() ;
+ return ;
+}
+
+sub _start {
+ my( $self, $timer_event ) = @_ ;
+ $timer_event->start() ;
+ return ;
+}
+
+sub _stop {
+ my( $self, $timer_event ) = @_ ;
+ $timer_event->stop() ;
+ return ;
+}
+
+############################################################################
+
+package Stem::Event::Read ;
+
+sub _build {
+
+ my( $self ) = @_ ;
+
+# create the read event watcher
+
+ return Event->io(
+ 'cb' => sub { $self->trigger() },
+ 'fd' => $self->{'fh'},
+ 'poll' => 'r',
+ ) ;
+}
+
+sub _cancel {
+ my( $self, $read_event ) = @_ ;
+ $read_event->cancel() ;
+ return ;
+}
+
+sub _start {
+ my( $self, $read_event ) = @_ ;
+ $read_event->start() ;
+ return ;
+}
+
+sub _stop {
+ my( $self, $read_event ) = @_ ;
+ $read_event->stop() ;
+ return ;
+}
+
+############################################################################
+
+package Stem::Event::Write ;
+
+sub _build {
+
+ my( $self ) = @_ ;
+
+# create the write event watcher
+
+# create the read event watcher
+
+ return Event->io(
+ 'cb' => sub { $self->trigger() },
+ 'fd' => $self->{'fh'},
+ 'poll' => 'w',
+ ) ;
+
+ return $self ;
+}
+
+sub _cancel {
+ my( $self, $write_event ) = @_ ;
+ $write_event->cancel() ;
+ return ;
+}
+
+sub _start {
+ my( $self, $write_event ) = @_ ;
+ $write_event->start() ;
+ return ;
+}
+
+sub _stop {
+ my( $self, $write_event ) = @_ ;
+ $write_event->stop() ;
+ return ;
+}
+
+1 ;
--- /dev/null
+# File: Stem/Event/Perl.pm
+
+# This file is part of Stem.
+# Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
+
+# Stem is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# Stem is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with Stem; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# For a license to use the Stem under conditions other than those
+# described here, to purchase support for this software, or to purchase a
+# commercial warranty contract, please contact Stem Systems at:
+
+# Stem Systems, Inc. 781-643-7504
+# 79 Everett St. info@stemsystems.com
+# Arlington, MA 02474
+# USA
+
+=head1 Stem::Event::Perl
+
+This module is a pure Perl event loop. It requires Perl 5.8 (or
+better) which has safe signal handling. It provides the common event
+API for the standard classes:
+
+=cut
+
+package Stem::Event::Perl ;
+
+use strict ;
+use Stem::Event::Signal ;
+
+@Stem::Event::Perl::ISA = qw( Stem::Event ) ;
+
+BEGIN {
+
+ unless ( eval { require Time::HiRes } ) {
+
+ Time::HiRes->import( qw( time ) ) ;
+ }
+}
+
+# get the hashes for each of the event types
+
+my ( $signal_events, $timer_events, $read_events, $write_events ) =
+ map scalar( Stem::Event::_get_events( $_ )), qw( signal timer
+ read write ) ;
+
+sub _start_loop {
+
+#print "PERL START\n" ;
+
+ while( keys %{$timer_events} ||
+ keys %{$signal_events} ||
+ keys %{$read_events} ||
+ keys %{$write_events} ) {
+
+ my $timeout = find_min_delay() ;
+
+#print "TIMEOUT [$timeout]\n" ;
+
+ my $time = time() ;
+
+ _one_time_loop( $timeout ) ;
+
+ my $delta_time = time() - $time ;
+ trigger_timer_events( $delta_time ) ;
+ }
+}
+
+sub _one_time_loop {
+
+ my( $timeout ) = @_ ;
+
+# force a no wait select call if no timeout was passed in
+
+ $timeout ||= 0 ;
+
+#print "ONE TIME $timeout\n" ;
+# use Carp qw( cluck ) ;
+# cluck ;
+
+# print "\n\n********EVENT LOOP\n\n" ;
+# print "READ EVENTS\n", map $_->dump(), values %{$read_events} ;
+# print "WRITE EVENTS\n", map $_->dump(), values %{$write_events} ;
+
+ my $read_vec = make_select_vec( $read_events ) ;
+ my $write_vec = make_select_vec( $write_events ) ;
+
+#print "R BEFORE ", unpack( 'b*', $read_vec), "\n" ;
+#print "W BEFORE ", unpack( 'b*', $write_vec), "\n" ;
+
+
+ my $cnt = select( $read_vec, $write_vec, undef, $timeout ) ;
+
+#print "SEL CNT [$cnt]\n" ;
+#print "R AFTER ", unpack( 'b*', $read_vec), "\n" ;
+#print "W AFTER ", unpack( 'b*', $write_vec), "\n" ;
+
+ trigger_select_vec( 'read', $read_events, $read_vec ) ;
+ trigger_select_vec( 'write', $write_events, $write_vec, ) ;
+
+#print "\n\n********END EVENT LOOP\n\n" ;
+
+}
+
+sub _stop_loop {
+
+ $_->cancel() for values %{$signal_events},
+ values %{$timer_events},
+ values %{$read_events},
+ values %{$write_events} ;
+}
+
+sub find_min_delay {
+
+ my $min_delay = 0 ;
+
+ while( my( undef, $event ) = each %{$timer_events} ) {
+
+ if ( $event->{'time_left'} < $min_delay || $min_delay == 0 ) {
+
+ $min_delay = $event->{'time_left'} ;
+
+#print "MIN [$min_delay]\n" ;
+ }
+ }
+
+ return unless $min_delay ;
+
+ return $min_delay ;
+}
+
+sub trigger_timer_events {
+
+ my( $delta ) = @_ ;
+
+#print "TIMER DELTA $delta\n" ;
+
+ while( my( undef, $event ) = each %{$timer_events} ) {
+
+#print $event->dump() ;
+
+ next unless $event->{'active'} ;
+
+ next unless ( $event->{'time_left'} -= $delta ) <= 0 ;
+
+ $event->timer_triggered() ;
+ }
+}
+
+sub make_select_vec {
+
+ my( $io_events ) = @_ ;
+
+ my $select_vec = '' ;
+
+ while( my( undef, $event ) = each %{$io_events} ) {
+
+#print "make F: [", fileno $event->{'fh'}, "] ACT [$event->{'active'}]\n" ;
+
+ unless ( defined fileno $event->{'fh'} ) {
+
+#print "BAD FH $event->{'fh'}\n" ;
+print "\n\n***EVENT BAD FH\n", $event->dump() ;
+
+ $event->cancel() ;
+ }
+
+ next unless $event->{'active'} ;
+ vec( $select_vec, fileno $event->{'fh'}, 1 ) = 1 ;
+ }
+
+ return $select_vec ;
+}
+
+sub trigger_select_vec {
+
+ my( $event_type, $io_events, $select_vec ) = @_ ;
+
+ while( my( undef, $event ) = each %{$io_events} ) {
+
+ next unless $event->{'active'} ;
+ if ( vec( $select_vec, fileno $event->{'fh'}, 1 ) ) {
+
+ $event->trigger() ;
+ }
+ }
+
+ return ;
+}
+
+############################################################################
+
+package Stem::Event::Plain ;
+
+######
+# right now we trigger plain events when they are created. this should
+# change to a queue and trigger after i/o and timer events
+######
+
+sub _build {
+ my( $self ) = @_ ;
+ $self->trigger() ;
+ return ;
+}
+
+1 ;
--- /dev/null
+# File: Stem/Event/Queue.pm
+
+# This file is part of Stem.
+# Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
+
+# Stem is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# Stem is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with Stem; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# For a license to use the Stem under conditions other than those
+# described here, to purchase support for this software, or to purchase a
+# commercial warranty contract, please contact Stem Systems at:
+
+# Stem Systems, Inc. 781-643-7504
+# 79 Everett St. info@stemsystems.com
+# Arlington, MA 02474
+# USA
+
+# this class provides a way to deliver certain events and messages
+# synchronously with the main event loop. this is done by queueing the
+# actual event/message and writing a byte down a special pipe used
+# only inside this process. the other side of the pipe has a read
+# event that when triggered will then deliver the queued
+# events/messages.
+
+# when using Stem::Event::Signal you need to use this module as
+# well. perl signals will be delivered (safely) between perl
+# operations but they could then be delivered inside an executing
+# event handler and that means possible corruption. so this module
+# allows those signal events to be delivered by the event loop itself.
+
+
+package Stem::Event::Queue ;
+
+use strict ;
+use warnings ;
+
+use Socket;
+use IO::Handle ;
+
+use base 'Exporter' ;
+our @EXPORT = qw( &mark_not_empty ) ;
+
+my( $queue_read, $queue_write, $queue_read_event ) ;
+
+my $self ;
+
+sub _init_queue {
+
+ socketpair( $queue_read, $queue_write,
+ AF_UNIX, SOCK_STREAM, PF_UNSPEC ) || die <<DIE ;
+can't create socketpair $!
+DIE
+
+#print fileno( $queue_read ), " FILENO\n" ;
+
+ $self = bless {} ;
+
+ $queue_read->blocking( 0 ) ;
+ $queue_read_event = Stem::Event::Read->new(
+ 'object' => $self,
+ 'fh' => $queue_read,
+ ) ;
+
+ ref $queue_read_event or die <<DIE ;
+can't create Stem::Event::Queue read event: $queue_read_event
+DIE
+
+}
+
+my $queue_is_marked ;
+
+sub mark_not_empty {
+
+ my( $always_mark ) = @_ ;
+
+# don't mark the queue if it is already marked and we aren't forced
+# the signal queue always marks the queue
+
+ return if $queue_is_marked && !$always_mark ;
+
+ syswrite( $queue_write, 'x' ) ;
+
+ $queue_is_marked = 1 ;
+}
+
+sub readable {
+
+ sysread( $queue_read, my $buf, 10 ) ;
+
+ $queue_is_marked = 0 ;
+
+# Stem::Event::Plain::process_queue();
+ Stem::Event::Signal::process_signal_queue();
+# Stem::Msg::process_queue() if defined &Stem::Msg::process_queue;
+
+ return ;
+}
+
+1 ;
--- /dev/null
+package Stem::Event::Signal ;
+
+use Stem::Event::Queue ;
+
+use strict ;
+use warnings ;
+
+use base 'Exporter' ;
+our @EXPORT = qw( process_signal_queue ) ;
+
+# this generic signal event code needs the safe signals of perl 5.8+
+
+use 5.008 ;
+
+my %signal2event ;
+
+my @signal_queue ;
+my %cached_handlers ;
+
+# this sub will cache the handler closures so we can reuse them.
+
+sub _build {
+
+ my( $self ) = @_ ;
+
+ my $signal = $self->{'signal'} ;
+
+ $self->{'method'} ||= "sig_\L${signal}_handler" ;
+
+# create the signal event handler and cache it.
+# we cache them so we can reuse these closures and never leak
+
+ $SIG{ $signal } = $cached_handlers{$signal} ||=
+ sub {
+ mark_not_empty() ;
+#print "HIT $signal\n";
+ push @signal_queue, $signal
+ } ;
+
+# track the event object for this signal
+
+ $signal2event{$signal} = $self ;
+
+#print "$signal = $SIG{ $signal }\n" ;
+ return ;
+}
+
+sub _cancel {
+
+ my( $self ) = @_ ;
+
+ $SIG{ $self->{'signal'} } = 'DEFAULT' ;
+
+ return ;
+}
+
+sub process_signal_queue {
+
+ my $sig_count = @signal_queue ;
+
+#print "PROCESS SIGNAL Q $sig_count\n" ;
+
+# return if we have no pending signals
+
+ return $sig_count unless $sig_count ;
+
+ while( my $signal = shift @signal_queue ) {
+
+ my $event = $signal2event{ $signal } ;
+
+ next unless $event ;
+ next unless $event->{'active'} ;
+
+ $event->trigger() ;
+ }
+
+ return $sig_count ;
+}
+
+1 ;
--- /dev/null
+# File: Stem/Event/Tk.pm
+
+# This file is part of Stem.
+# Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
+
+# Stem is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# Stem is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with Stem; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# For a license to use the Stem under conditions other than those
+# described here, to purchase support for this software, or to purchase a
+# commercial warranty contract, please contact Stem Systems at:
+
+# Stem Systems, Inc. 781-643-7504
+# 79 Everett St. info@stemsystems.com
+# Arlington, MA 02474
+# USA
+
+=head1 Stem::Event::Tk
+
+This module wraps the CPAN module Event.pm for use by the rest of
+Stem. It provides the common API for the standard Stem::Event classes:
+
+=over 4
+
+=item Stem::Event
+=item Stem::Event::Plain
+=item Stem::Event::Timer
+=item Stem::Event::Signal
+=item Stem::Event::Read
+=item Stem::Event::Write
+
+=back
+
+=cut
+
+package Stem::Event::Tk ;
+
+use strict ;
+use Tk ;
+
+use Stem::Event::Signal ;
+
+my $tk_main_window ;
+
+# basic wrappers for top level Tk.pm calls.
+
+sub _init_loop {
+
+ $tk_main_window ||= MainWindow->new() ;
+ $tk_main_window->withdraw() ;
+}
+
+sub _start_loop {
+ _init_loop() ;
+ MainLoop() ;
+}
+
+sub _stop_loop {
+
+#print "STOP INFO ", $tk_main_window->afterInfo(), "\n" ;
+
+ $tk_main_window->destroy() ;
+ $tk_main_window = undef ;
+}
+
+############################################################################
+
+package Stem::Event::Plain ;
+
+sub _build {
+
+ my( $self ) = @_ ;
+
+# create the plain event watcher
+
+ $self->{'idle_event'} = Event->idle(
+ 'cb' => [ $self, 'idle_triggered' ],
+ 'repeat' => 0
+ ) ;
+
+ return $self ;
+}
+
+sub idle_triggered {
+
+ my( $self ) = @_ ;
+
+ $self->trigger() ;
+ my $idle_event = delete $self->{'idle_event'} ;
+ $idle_event->cancel() ;
+}
+
+############################################################################
+
+package Stem::Event::Timer ;
+
+sub _build {
+
+ my( $self ) = @_ ;
+
+Stem::Event::Tk::_init_loop() ;
+
+# tk times in milliseconds and stem times in floating seconds so
+# we convert to integer ms.
+
+ my $delay_ms = int( $self->{'delay'} * 1000 ) ;
+
+# $self->{interval_ms} = int( ( $self->{'interval'} || 0 ) * 1000 ) ;
+
+ my $timer_method = $self->{'interval'} ? 'repeat' : 'after' ;
+
+ return $tk_main_window->$timer_method(
+ $delay_ms,
+ [$self => 'timer_triggered']
+ ) ;
+}
+
+sub _reset {
+
+ my( $self, $timer_event, $delay ) = @_ ;
+ my $delay_ms = int( $delay * 1000 ) ;
+ $timer_event->time( $delay_ms ) ;
+}
+
+sub _cancel {
+ my( $self, $timer_event ) = @_ ;
+ $timer_event->cancel() ;
+ return ;
+}
+
+############################################################################
+
+package Stem::Event::Read ;
+
+sub _build {
+
+ my( $self ) = @_ ;
+ goto &_start if $self->{active} ;
+ return ;
+}
+
+sub _start {
+
+ my( $self ) = @_ ;
+
+ return $tk_main_window->fileevent(
+ $self->{'fh'},
+ 'readable',
+ [$self => 'trigger']
+ ) ;
+}
+
+sub _cancel { goto &_stop }
+
+sub _stop {
+ my( $self ) = @_ ;
+
+ $tk_main_window->fileevent(
+ $self->{'fh'},
+ 'readable',
+ ''
+ ) ;
+}
+
+############################################################################
+
+package Stem::Event::Write ;
+
+sub _build {
+ my( $self ) = @_ ;
+ goto &_start if $self->{active} ;
+ return ;
+}
+
+sub _start {
+
+ my( $self ) = @_ ;
+
+ return $tk_main_window->fileevent(
+ $self->{'fh'},
+ 'writable',
+ [$self => 'trigger']
+ ) ;
+}
+
+sub _cancel { goto &_stop }
+
+sub _stop {
+
+ my( $self ) = @_ ;
+
+ $tk_main_window->fileevent(
+ $self->{'fh'},
+ 'writable',
+ ''
+ ) ;
+}
+
+1 ;
--- /dev/null
+# File: Stem/Event/Wx.pm
+
+# This file is part of Stem.
+# Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
+
+# Stem is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# Stem is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with Stem; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# For a license to use the Stem under conditions other than those
+# described here, to purchase support for this software, or to purchase a
+# commercial warranty contract, please contact Stem Systems at:
+
+# Stem Systems, Inc. 781-643-7504
+# 79 Everett St. info@stemsystems.com
+# Arlington, MA 02474
+# USA
+
+=head1 Stem::Event::Wx
+
+This module is a pure Perl event loop. It requires Perl 5.8 (or
+better) which has safe signal handling. It provides the common event
+API for the standard classes:
+
+=cut
+
+package Stem::Event::Wx ;
+
+use strict ;
+
+use base qw( Stem::Event ) ;
+use Stem::Event::Perl ;
+use Wx ;
+
+my $app = Stem::Event::Wx::App->new() ;
+my $wx_timer = Stem::Event::Wx::Timer->new() ;
+
+# this will call the io_poll_timer method in $wx_timer's class
+
+my $io_poll_timer = Stem::Event::Timer->new(
+ object => $wx_timer,
+ interval => 1, # .1 second poll
+ method => 'io_poll_timer',
+) ;
+
+sub _start_loop {
+
+# _build just sets the min delay for the wx timer. this will make sure
+# any timer events get going when we start the loop.
+
+ Stem::Event::Timer::_build() ;
+ Wx::wxTheApp->MainLoop() ;
+}
+
+sub _stop_loop {
+
+ Wx::wxTheApp->ExitMainLoop() ;
+}
+
+
+package Stem::Event::Timer ;
+
+sub _build {
+
+ my $min_delay = Stem::Event::Perl::find_min_delay() ;
+ $wx_timer->set_wx_timer_delay( $min_delay ) ;
+ return ;
+}
+
+############################################################################
+
+# this class subclasses Wx::Timer and its Notify method will be called
+# after the current delay.
+
+package Stem::Event::Wx::Timer ;
+
+use base qw( Wx::Timer ) ;
+
+BEGIN {
+
+ unless ( eval { require Time::HiRes } ) {
+
+ Time::HiRes->import( qw( time ) ) ;
+ }
+}
+
+my $last_time ;
+
+sub set_wx_timer_delay {
+
+ my( $self, $delay ) = @_ ;
+
+#print "WX DELAY [$delay]\n" ;
+ if ( $delay ) {
+
+ $self->Start( int( $delay * 1000 ), 0 );
+ $last_time = time() ;
+ return ;
+ }
+
+ $self->Stop();
+}
+
+# Wx calls this method when its timers get triggered. this is the only
+# wx timer callback in this wrapper. all the others are handled with
+# perl in Event.pm and Event/Perl.pm
+
+sub Notify {
+
+#print "NOTIFY\n" ;
+ my $delta_time = time() - $last_time ;
+ my $min_delay = Stem::Event::Perl::find_min_delay() ;
+ $wx_timer->set_wx_timer_delay( $min_delay ) ;
+ Stem::Event::Perl::trigger_timer_events( $delta_time ) ;
+}
+
+sub io_poll_timer {
+
+#print "IO POLL\n" ;
+
+ Stem::Event::Perl::_one_time_loop() ;
+}
+
+
+############################################################################
+
+# this class is needed to subclass Wx::App and to make our own
+# WxApp. it needs to provide OnInit which is called at startup and has
+# to return true.
+
+package Stem::Event::Wx::App ;
+
+use base 'Wx::App' ;
+sub OnInit { return( 1 ) }
+
+1 ;
+
+__END__
--- /dev/null
+# File: Stem/File.pm
+
+# This file is part of Stem.
+# Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
+
+# Stem is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# Stem is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with Stem; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# For a license to use the Stem under conditions other than those
+# described here, to purchase support for this software, or to purchase a
+# commercial warranty contract, please contact Stem Systems at:
+
+# Stem Systems, Inc. 781-643-7504
+# 79 Everett St. info@stemsystems.com
+# Arlington, MA 02474
+# USA
+
+package Stem::File ;
+
+use strict ;
+
+my $attr_spec = [
+
+ {
+ 'name' => 'path',
+ 'required' => 1,
+ 'help' => <<HELP,
+This is just the path to the file. Given Unix conventions, the path
+may include the full file name from the root. It's required.
+HELP
+ },
+
+ {
+ 'name' => 'mode',
+ 'default' => 'read',
+ 'help' => <<HELP,
+Can be read (default), write, or read/write. Indicates how the file
+is to be opened using Unix conventions.
+HELP
+ },
+
+] ;
+
+
+sub new {
+
+ my( $class ) = shift ;
+
+ my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
+ return $self unless ref $self ;
+
+ return $self ;
+}
+
+
+sub msg_in {
+
+ my( $self, $msg ) = @_ ;
+
+ my $type = $msg->type() ;
+
+#print $msg->dump( 'switch' ) ;
+
+ if ( $type eq 'cmd' ) {
+
+ $self->cmd_in( $msg ) ;
+ return ;
+ }
+}
+
+
+sub read {
+
+ my( $self, $read_size_wanted ) = @_ ;
+
+
+}
+
+sub read_line {
+
+ my( $self, $read_size_wanted ) = @_ ;
+
+ $self->{'handle'}->readline() ;
+}
+
+sub write {
+
+ my( $self, $write_data ) = @_ ;
+
+ $self->{'handle'}->write( $write_data ) ;
+}
+
+sub close {
+
+ my( $self ) = @_ ;
+
+ $self->{'handle'}->close() ;
+
+ delete( $self->{'handle'} ) ;
+}
+
+1 ;
--- /dev/null
+# File: Stem/Gather.pm
+
+# This file is part of Stem.
+# Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
+
+# Stem is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# Stem is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with Stem; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# For a license to use the Stem under conditions other than those
+# described here, to purchase support for this software, or to purchase a
+# commercial warranty contract, please contact Stem Systems at:
+
+# Stem Systems, Inc. 781-643-7504
+# 79 Everett St. info@stemsystems.com
+# Arlington, MA 02474
+# USA
+
+package Stem::Gather ;
+
+#use Stem::Trace 'log' => 'stem_status', 'sub' => 'TraceStatus' ;
+#use Stem::Trace 'log' => 'stem_error' , 'sub' => 'TraceError' ;
+
+=head1 Description
+
+This is a object module used by Stem Cells and objects to detect when
+a set of asynchronous events have finished. It is constructed by an
+owner object which then stores it in itselt. Gather objects are
+initialized with a set of keys to be gathered. When the owner object
+is notified of an event, it calls the C<gathered> method of the gather
+object with a list of keys. When all of the keys are gathered, a
+callback is made to the owner object. An optional timeout is available
+which will also generate a callback if the keys are not gathered in
+time.
+
+=head1 Synopsis
+
+ use Stem::Gather ;
+
+ # $self is the owner object that has already been created
+
+ my $gather = Stem::Gather->new(
+ 'object' => $self,
+ 'keys' => [qw( msg1 msg2 )]
+ ) ;
+
+ $self->{'gather'} = $gather ;
+
+ sub msg1_in {
+
+ my( $self ) = @_ ;
+ $self->{'gather'}->gathered( 'msg1' ) ;
+ }
+
+ sub msg2_in {
+
+ my( $self ) = @_ ;
+ $self->{'gather'}->gathered( 'msg2' ) ;
+ }
+
+ sub gather_done {
+
+ my( $self ) = @_ ;
+
+ print "we have gathered\n" ;
+ }
+
+=cut
+
+use strict ;
+
+my %class_to_attr_name ;
+
+my $attr_spec = [
+
+ {
+ 'name' => 'object',
+ 'required' => 1,
+ 'type' => 'object',
+ 'help' => <<HELP,
+This is the owner object which has the methods that get called when Stem::Gather
+has either finished gathering all of the keys or it has timed out.
+HELP
+ },
+ {
+ 'name' => 'keys',
+ 'required' => 1,
+ 'type' => 'list',
+ 'help' => <<HELP,
+This is the list of keys to gather.
+HELP
+ },
+ {
+ 'name' => 'gathered_method',
+ 'default' => 'gather_done',
+ 'help' => <<HELP,
+This method is called in the owner object when all of the keys are gathered.
+HELP
+ },
+ {
+ 'name' => 'no_start',
+ 'type' => 'boolean',
+ 'help' => <<HELP,
+If set, then do not start the gather object upon creation. A call to
+the C<restart> must be made. This only meaningful if this gather has a
+timeout set.
+HELP
+ },
+ {
+ 'name' => 'timeout',
+ 'help' => <<HELP,
+This is an optional timeout period (in seconds) waiting for the gather
+to be completed
+HELP
+ },
+ {
+ 'name' => 'timeout_method',
+ 'default' => 'gather_timeout',
+ 'help' => <<HELP,
+This method is called in the owner object if the gather timed out
+before all keys were gathered.
+HELP
+ },
+] ;
+
+
+###########
+# This POD section is autoegenerated. Any edits to it will be lost.
+
+=head2 Constructor Attributes for Class Stem::Gather
+
+=over 4
+
+
+=item * Attribute - B<object>
+
+=over 4
+
+
+=item Description:
+This is the owner object which has the methods that get called when Stem::Gather
+has either finished gathering all of the keys or it has timed out.
+
+
+=item Its B<type> is: object
+
+=item It is B<required>.
+
+=back
+
+=item * Attribute - B<keys>
+
+=over 4
+
+
+=item Description:
+This is the list of keys to gather.
+
+
+=item Its B<type> is: list
+
+=item It is B<required>.
+
+=back
+
+=item * Attribute - B<gathered_method>
+
+=over 4
+
+
+=item Description:
+This method is called in the owner object when all of the keys are gathered.
+
+
+=item It B<defaults> to: gather_done
+
+=back
+
+=item * Attribute - B<no_start>
+
+=over 4
+
+
+=item Description:
+If set, then do not start the gather object upon creation. A call to
+the C<restart> must be made. This only meaningful if this gather has a
+timeout set.
+
+
+=item Its B<type> is: boolean
+
+=back
+
+=item * Attribute - B<timeout>
+
+=over 4
+
+
+=item Description:
+This is an optional timeout period (in seconds) waiting for the gather
+to be completed
+
+
+=back
+
+=item * Attribute - B<timeout_method>
+
+=over 4
+
+
+=item Description:
+This method is called in the owner object if the gather timed out
+before all keys were gathered.
+
+
+=item It B<defaults> to: gather_timeout
+
+=back
+
+=back
+
+=cut
+
+# End of autogenerated POD
+###########
+
+
+
+
+=head2 Method new
+
+This is the constructor method for Stem::Gather. It uses the standard
+Stem key/value API with the
+
+=cut
+
+sub new {
+
+ my( $class ) = shift ;
+
+ my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
+ return $self unless ref $self ;
+
+# return 'Stem::Gather "keys" is not an array reference'
+# unless ref $self->{'keys'} eq 'ARRAY' ;
+
+ $self->restart() unless $self->{'no_start'} ;
+
+ return( $self ) ;
+}
+
+=head2 Method restart
+
+This method is called to start up the gather object when it has
+already gathered all the keys, it has timed out or it was never
+started (the no_start attribute was enabled). It takes no arguments.
+
+=cut
+
+
+sub restart {
+
+ my( $self ) = @_ ;
+
+ $self->{'gathered'} = 0 ;
+
+ $self->{'keys_left'} = { map { $_, 1 } @{$self->{'keys'}} } ;
+
+# TraceStatus "GAT keys '@{$self->{'keys'}}'" ;
+
+ $self->_cancel_timeout() ;
+
+ if ( my $timeout = $self->{'timeout'} ) {
+
+ $self->{'timer_event'} = Stem::Event::Timer->new(
+ 'object' => $self,
+ 'delay' => $timeout,
+ 'hard' => 1,
+ 'repeat' => 0 ) ;
+ }
+}
+
+=head2 Method add_keys
+
+This method is passed a list of keys which will be added to the list
+to be watched for by the Stem::Gather object. The new keys are not
+looked for until a call to the C<restart> method is made.
+
+=cut
+
+sub add_keys {
+
+ my( $self, @keys ) = @_ ;
+
+ push @{$self->{'keys'}}, @keys ;
+}
+
+=head2 Method gathered
+
+This method is called with a list of keys that are gathered. The keys
+that haven't been gathered before are marked as gathered. If there are
+no more keys to be gathered, the method in the C<gathered_method>
+attribute is called in the owner object. You have to call the
+C<restart> method on this gather object to use it again.You can pass
+this methods keys that have been gathered or are not even in the list
+to be gathered and they are ignored.
+
+=cut
+
+sub gathered {
+
+ my( $self, @keys ) = @_ ;
+
+# TraceStatus "gathered: @keys" ;
+
+ return if $self->{'gathered'} ;
+
+ delete @{$self->{'keys_left'}}{@keys} ;
+
+ return if keys %{$self->{'keys_left'}} ;
+
+ $self->_cancel_timeout() ;
+ $self->{'gathered'} = 1 ;
+
+ my $method = $self->{'gathered_method'} ;
+
+# TraceStatus "gathered done: calling $method" ;
+
+ return $self->{'object'}->$method() ;
+}
+
+sub timed_out {
+
+ my( $self ) = @_ ;
+
+ $self->_cancel_timeout() ;
+
+ my $method = $self->{'timeout_method'} ;
+ $self->{'object'}->$method() ;
+
+ return ;
+}
+
+sub _cancel_timeout {
+
+ my( $self ) = @_ ;
+
+ if ( my $timer = $self->{'timer_event'} ) {
+ $timer->cancel() ;
+
+ delete $self->{'timer_event'} ;
+ }
+}
+
+=head2 Method
+
+This method B<must> be called if the owner object is being shut down or
+destroyed. It will cancel any pending timeout and break the link back
+to the owner object. The owner object can then be destroyed without
+leaking memory.
+
+=cut
+
+sub shut_down {
+
+ my( $self ) = @_ ;
+
+ $self->_cancel_timeout() ;
+
+ delete $self->{'object'} ;
+}
+
+1 ;
--- /dev/null
+# File: Stem/Hub.pm
+
+# This file is part of Stem.
+# Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
+
+# Stem is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# Stem is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with Stem; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# For a license to use the Stem under conditions other than those
+# described here, to purchase support for this software, or to purchase a
+# commercial warranty contract, please contact Stem Systems at:
+
+# Stem Systems, Inc. 781-643-7504
+# 79 Everett St. info@stemsystems.com
+# Arlington, MA 02474
+# USA
+
+package Stem::Hub ;
+
+use Stem::Trace 'log' => 'stem_status', 'sub' => 'TraceStatus' ;
+use Stem::Trace 'log' => 'stem_error' , 'sub' => 'TraceError' ;
+
+use strict ;
+use Carp ;
+use Sys::Hostname ;
+
+use Stem::Vars ;
+
+$Stem::Vars::Hub_name = '' ;
+$Stem::Vars::Program_name = $0 ;
+$Stem::Vars::Host_name = hostname() ;
+
+Stem::Route::register_class( __PACKAGE__, 'hub' ) ;
+
+my $attr_spec = [
+
+ {
+ 'name' => 'reg_name',
+ 'help' => <<HELP,
+The registration name is used to name this Hub.
+HELP
+ },
+
+] ;
+
+
+###########
+# This POD section is autoegenerated. Any edits to it will be lost.
+
+=head2 Constructor Attributes for Class Stem::Hub
+
+=over 4
+
+
+=item * Attribute - B<reg_name>
+
+=over 4
+
+
+=item Description:
+The registration name is used to name this Hub.
+
+
+=back
+
+=back
+
+=cut
+
+# End of autogenerated POD
+###########
+
+
+
+
+sub new {
+
+ my( $class ) = shift ;
+
+ my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
+ return $self unless ref $self ;
+
+ $Stem::Vars::Hub_name = $Env{ 'hub_name' } ||
+ $self->{ 'reg_name' } ||
+ $Stem::Vars::Program_name ;
+
+ TraceStatus "hub name is '$Stem::Vars::Hub_name'" ;
+
+###########################
+###########################
+# add code to open hub log
+#
+###########################
+###########################
+
+ return ;
+}
+
+sub status_cmd {
+
+ my $hub = $Stem::Vars::Hub_name || 'NONE' ;
+
+ return <<STATUS ;
+
+ Hub Status
+
+Name: $hub
+Host: $Stem::Vars::Host_name
+Program: $Stem::Vars::Program_name
+
+STATUS
+
+}
+
+1 ;
--- /dev/null
+# File: Stem/Id.pm
+
+# This file is part of Stem.
+# Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
+
+# Stem is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# Stem is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with Stem; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# For a license to use the Stem under conditions other than those
+# described here, to purchase support for this software, or to purchase a
+# commercial warranty contract, please contact Stem Systems at:
+
+# Stem Systems, Inc. 781-643-7504
+# 79 Everett St. info@stemsystems.com
+# Arlington, MA 02474
+# USA
+
+package Stem::Id ;
+
+use strict ;
+
+=pod
+
+This module generates unique Id strings for use as names in Stem
+addresses. Its most common use is by parent Cells which clone
+themselves and need a unique Target. The parent Cell uses its Cell
+name and the new Target to register the cloned Cell.
+
+=cut
+
+my $attr_spec = [
+
+ {
+ 'name' => 'size',
+ 'default' => 6,
+ 'help' => <<HELP,
+This sets the number of characters in the Id. It defaults to 6.
+HELP
+ },
+
+] ;
+
+
+###########
+# This POD section is autoegenerated. Any edits to it will be lost.
+
+=head2 Constructor Attributes for Class Stem::Id
+
+=over 4
+
+
+=item * Attribute - B<size>
+
+=over 4
+
+
+=item Description:
+This sets the number of characters in the Id. It defaults to 6.
+
+
+=item It B<defaults> to: 6
+
+=back
+
+=back
+
+=cut
+
+# End of autogenerated POD
+###########
+
+
+
+=head2 new
+
+The new method constructs a Stem::Id object. It initializes the Id
+string to a string of 'a's. The string size determines how long this
+object can go before it has to reuse previously deleted Id strings.
+
+=cut
+
+sub new {
+
+ my( $class ) = shift ;
+
+ my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
+ return $self unless ref $self ;
+
+ my $size = $self->{'size'} ;
+
+ $self->{'start'} = 'a' x $size ;
+ $self->{'next'} = 'a' x $size ;
+ $self->{'end'} = 'a' x ( $size + 1 ) ;
+ $self->{'in_use'} = {} ;
+
+ return $self ;
+}
+
+=head2 next
+
+The next method returns the next available Id in the object and marks
+that as in use. It fails if all possible Id's are in use.
+
+=cut
+
+sub next {
+
+ my( $self ) = @_ ;
+
+ my $next = $self->{'next'} ;
+ my $curr_next = $next ;
+ my $end = $self->{'end'} ;
+ my $in_use = $self->{'in_use'} ;
+
+ while( exists( $in_use->{$next} ) ) {
+
+ $next++ ;
+
+# fail if we looped around.
+
+#print "curr $curr_next $next\n" ;
+
+ return if $next eq $curr_next ;
+
+ $next = $self->{'start'} if $next eq $end ;
+ }
+
+ $in_use->{$next} = 1 ;
+ $self->{'next'} = $next ;
+
+ return $next ;
+}
+
+=head2 delete
+
+The delete method allows this Id to be reused by a call to the next
+method.
+
+=cut
+
+sub delete {
+
+ my( $self, $id ) = @_ ;
+
+ delete $self->{'in_use'}{ $id } ;
+}
+
+=head2 dump
+
+The dump method returns a the list of Ids that are in use. used. It
+either returns the list of keys or an anonymous array with them
+depending on the calling context.
+
+=cut
+
+sub dump {
+
+ my( $self ) = @_ ;
+
+ return( wantarray ? keys %{ $self->{'in_use'} } :
+ [ keys %{ $self->{'in_use'} } ] ) ;
+}
+
+1 ;
--- /dev/null
+# -*- mode: cperl; cperl-indent-level:8; tab-width:8; indent-tabs-mode:t; -*-
+
+# File: Stem/Inject.pm
+
+# This file is part of Stem.
+# Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
+
+# Stem is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# Stem is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with Stem; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# For a license to use the Stem under conditions other than those
+# described here, to purchase support for this software, or to purchase a
+# commercial warranty contract, please contact Stem Systems at:
+
+# Stem Systems, Inc. 781-643-7504
+# 79 Everett St. info@stemsystems.com
+# Arlington, MA 02474
+# USA
+
+#######################################################
+
+package Stem::Inject ;
+
+use strict ;
+
+use IO::Socket ;
+
+use Stem::Msg ;
+use Stem::Packet ;
+
+my $attr_spec = [
+
+ {
+ 'name' => 'host',
+ 'required' => 1,
+ 'help' => <<HELP,
+The hostname to use when connecting to the portal.
+HELP
+ },
+
+ {
+ 'name' => 'port',
+ 'required' => 1,
+ 'help' => <<HELP,
+The port to use when connecting to the portal.
+HELP
+ },
+
+ {
+ 'name' => 'to',
+ 'required' => 1,
+ 'help' => <<HELP,
+The cell to which the message is addressed.
+HELP
+ },
+
+ {
+ 'name' => 'type',
+ 'required' => 1,
+ 'help' => <<HELP,
+This is the type of the message. It is used to select the delivery method in
+the addressed Cell.
+HELP
+ },
+
+ {
+ 'name' => 'cmd',
+ 'help' => <<HELP,
+This is used for the delivery method if the message type is 'cmd'.
+HELP
+ },
+
+ {
+ 'name' => 'codec',
+ 'help' => <<HELP,
+The Stem::Codec module to use when creating packets.
+HELP
+ },
+
+ {
+ 'name' => 'data',
+ 'help' => <<HELP,
+This is the data the message is carrying. It should (almost) always be
+a reference.
+HELP
+ },
+
+ {
+ 'name' => 'timeout',
+ 'default' => 60,
+ 'help' => <<HELP,
+The timeout before giving up on getting a reply from the portal, in
+seconds. Defaults to 60.
+HELP
+ },
+
+ {
+ 'name' => 'wait_for_reply',
+ 'default' => 1,
+ 'help' => <<HELP,
+Indicates whether or not a reply is expected. Defaults to true.
+HELP
+ },
+
+] ;
+
+sub inject {
+
+ my $class = shift ;
+
+ my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
+ return $self unless ref $self ;
+
+ $self->{'from'} = "Stem::Inject:inject$$";
+
+ $self->{'packet'} =
+ Stem::Packet->new( codec => $self->{'codec'} ) ;
+
+ local $SIG{'ALRM'} = sub { die 'Read or write to socket timed out' };
+
+ my $result;
+
+ eval {
+
+ my $address = "$self->{'host'}:$self->{'port'}";
+ $self->{'sock'} = IO::Socket::INET->new($address) ;
+ $self->{'sock'} or die "can't connect to $address\n" ;
+
+ alarm $self->{'timeout'} if $self->{'timeout'} ;
+
+ $self->_register() ;
+
+ $result = $self->_inject_msg() ;
+ } ;
+
+ alarm 0 ;
+
+ return $@ if $@ ;
+
+ return unless $self->{'wait_for_reply'};
+
+ return $result ;
+}
+
+sub _register {
+
+ my( $self, $data ) = @_ ;
+
+ my $reg_msg =
+ Stem::Msg->new( from => $self->{'from'},
+ type => 'register',
+ ) ;
+
+ die $reg_msg unless ref $reg_msg ;
+
+ my $reg = $self->{'packet'}->to_packet($reg_msg) ;
+
+ my $written = syswrite( $self->{'sock'}, $$reg ) ;
+ defined $written or die "can't write to socket\n" ;
+
+ my $read_buf ;
+ while (1) {
+
+ my $bytes_read = sysread( $self->{'sock'}, $read_buf, 8192 ) ;
+
+ defined $bytes_read or die "can't read from socket" ;
+ last if $bytes_read == 0 ;
+
+ my $data = $self->{'packet'}->to_data( $read_buf ) ;
+
+ last;
+ }
+}
+
+sub _inject_msg {
+
+ my( $self ) = @_;
+
+ my %msg_p =
+ ( 'to' => $self->{'to'},
+ 'from' => $self->{'from'},
+ 'type' => $self->{'type'},
+ ) ;
+
+ $msg_p{'cmd'} = $self->{'cmd'} if $self->{'type'} eq 'cmd';
+ $msg_p{'data'} = $self->{'data'},
+
+ my $data_msg = Stem::Msg->new(%msg_p) ;
+
+ die $data_msg unless ref $data_msg ;
+
+ my $data = $self->{'packet'}->to_packet($data_msg) ;
+
+ my $written = syswrite( $self->{'sock'}, $$data ) ;
+ defined $written or die "can't write to socket\n" ;
+
+ return unless $self->{'wait_for_reply'};
+
+ my $read_buf ;
+ while (1) {
+
+ my $bytes_read = sysread( $self->{'sock'}, $read_buf, 8192 ) ;
+
+ defined $bytes_read or die "can't read from socket" ;
+ last if $bytes_read == 0 ;
+
+ my $reply = $self->{'packet'}->to_data( $read_buf ) ;
+
+ return $reply->data ;
+ }
+}
+
+1 ;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Stem::Inject - Inject a message into a portal via a socket connection
+
+=head1 SYNOPSIS
+
+ my $return =
+ Stem::Inject->inject( to => 'some_cell',
+ type => 'do_something',
+ port => 10200,
+ host => 'localhost',
+ data => { foo => 1 },
+ );
+
+ # do something with data returned
+
+=head1 USAGE
+
+This class contains just one method, C<inject>, which can be used to
+inject a single message into a Stem hub, via a known server portal.
+
+This is very useful if you have a synchronous system which needs to
+communicate with a Stem system via messages.
+
+=head1 METHODS
+
+=over 4
+
+=item * inject
+
+This method is the sole interface provided by this class. It accepts
+the following parameters:
+
+=over 8
+
+=item * host (required)
+
+This parameter specifies the host with which to connect.
+
+=item * port (required)
+
+The port with which to connect on the specified host.
+
+=item * to (required)
+
+The address of the cell to which the message should be delivered.
+
+=item * type (required)
+
+The type of the message to be delivered.
+
+=item * cmd
+
+The cmd being given. This is only needed if the message's type is
+"cmd".
+
+=item * data
+
+The data that the message will carry, if any.
+
+=item * codec
+
+The codec to be used when communicating with the port. This defaults
+to "Data::Dumper", but be careful to set this to whatever value the
+receiving port is using.
+
+=item * timeout (defaults to 60)
+
+The amount of time, in seconds, before giving up on message delivery
+or reply. This is the I<total> amount of time allowed for message
+delivery and receiving a reply.
+
+=item * wait_for_reply (defaults to true)
+
+If this is true then the C<inject> method will expect a reply to the
+message it delivers. If it doesn't receive one this will be
+considered an error.
+
+=back
+
+If there is an error in trying to inject a message, either with the
+parameters given, or with the socket connection, then this method will
+return an error string.
+
+If no reply was expected, this method simply returns false.
+Otherwise, it returns the reply message's data, which will always be a
+reference.
+
+=back
+
+=head1 AUTHOR
+
+Dave Rolsky <david@stemsystems.com>
+
+=cut
--- /dev/null
+
+package Stem::Load::Driver ;
+
+use strict ;
+
+use Time::HiRes qw( gettimeofday tv_interval ) ;
+
+my $attr_spec = [
+
+
+ {
+ 'name' => 'reg_name',
+ 'help' => <<HELP,
+Name this Cell was registered with.
+HELP
+ },
+ {
+ 'name' => 'load_addr',
+ 'help' => <<HELP,
+Address to send the load messages
+HELP
+ },
+ {
+ 'name' => 'load_data',
+ 'help' => <<HELP,
+Data string to send.
+HELP
+ },
+ {
+ 'name' => 'data_sizes',
+ 'help' => <<HELP,
+Range of data sizes to select from randomly
+HELP
+ },
+ {
+ 'name' => 'max_msg_cnt',
+ 'default' => 1000,
+ 'help' => <<HELP,
+Maximum number of messages to send
+HELP
+ },
+ {
+ 'name' => 'max_duration',
+ 'default' => 10,
+ 'help' => <<HELP,
+Maximum number of seconds to run
+HELP
+ },
+] ;
+
+sub new {
+
+ my( $class ) = shift ;
+
+ my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
+ return $self unless ref $self ;
+
+ return $self ;
+}
+
+sub go_cmd {
+
+ my( $self, $msg ) = @_ ;
+
+ $self->{'echo_cnt'} = 0 ;
+
+ $self->{'start_time'} = gettimeofday() ;
+
+ $self->{'go_from_addr'} = $msg->from() ;
+
+ $self->send_load_msg() ;
+
+ return "Load Started\n" ;
+}
+
+sub response_in {
+
+ my( $self, $msg ) = @_ ;
+
+ my $time_delta = gettimeofday() - $self->{'start_time'} ;
+
+ if ( ++$self->{'echo_cnt'} >= $self->{'max_msg_cnt'} ||
+ $time_delta > $self->{'max_duration'} ) {
+
+ my $msgs_per_second = $self->{'echo_cnt'} / $time_delta ;
+
+ my $done_msg = Stem::Msg->new(
+ 'to' => $self->{'go_from_addr'},
+ 'from' => $self->{'reg_name'},
+ 'type' => 'response',
+ 'data' => <<DATA,
+sent $self->{'echo_cnt'} messages in $time_delta seconds
+$msgs_per_second messages per second
+DATA
+ ) ;
+
+ $done_msg->dispatch() ;
+
+ return ;
+ }
+
+ $self->send_load_msg() ;
+
+ return ;
+}
+
+
+sub send_load_msg {
+
+ my( $self ) = @_ ;
+
+ $self->{'echo_msg'} ||= Stem::Msg->new(
+ 'to' => $self->{'load_addr'},
+ 'from' => $self->{'reg_name'},
+ 'type' => 'echo',
+ 'data' => \'echo me',
+ ) ;
+
+ $self->{'echo_msg'}->dispatch() ;
+
+ return ;
+}
+
+1 ;
--- /dev/null
+
+
+package Stem::Load::Ticker ;
+
+use strict ;
+
+use Time::HiRes qw( gettimeofday tv_interval ) ;
+
+my $attr_spec = [
+
+
+ {
+ 'name' => 'reg_name',
+ 'help' => <<HELP,
+Name this Cell was registered with.
+HELP
+ },
+ {
+ 'name' => 'dbi_addr',
+ 'help' => <<HELP,
+Address to send the insert messages
+HELP
+ },
+ {
+ 'name' => 'max_cnt',
+ 'default' => 20,
+ 'help' => <<HELP,
+Maximum number of rows to insert
+HELP
+ },
+ {
+ 'name' => 'parallel_cnt',
+ 'default' => 1,
+ 'help' => <<HELP,
+Number of inserts to do in parallel
+HELP
+ },
+] ;
+
+sub new {
+
+ my( $class ) = shift ;
+
+ my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
+ return $self unless ref $self ;
+
+ return $self ;
+}
+
+sub go_cmd {
+
+ my( $self, $msg ) = @_ ;
+
+ my %go_args ;
+
+ if ( my $data = $msg->data() ) {
+
+ %go_args = ${$data} =~ /(\S+)=(\S+)/g if $$data ;
+ }
+
+ $self->{'start_time'} = gettimeofday() ;
+ $self->{'go_from_addr'} = $msg->from() ;
+ $self->{'go_max_cnt'} = $go_args{'max_cnt'} || $self->{'max_cnt'} ;
+
+ $self->{'inserted_cnt'} = 0 ;
+ $self->{'send_cnt'} = $self->{'go_max_cnt'} ;
+ $self->{'parallel_cnt'} = $go_args{'para_cnt'} if $go_args{'para_cnt'} ;
+
+ $self->send_ticker_msgs( $self->{'parallel_cnt'} ) ;
+
+ return "Ticker Started\n" ;
+}
+
+sub send_ticker_msgs {
+
+ my( $self, $parallel_cnt ) = @_ ;
+
+#print "PARA $parallel_cnt\n" ;
+
+ while ( $parallel_cnt-- ) {
+
+ $self->insert_ticker_row() ;
+ }
+
+ return ;
+}
+
+sub insert_ticker_row {
+
+ my( $self ) = @_ ;
+
+ return if $self->{'send_cnt'} <= 0 ;
+ $self->{'send_cnt'}-- ;
+
+ my $ticker = join '', map ['A' .. 'Z']->[rand 26], 1 .. 3 ;
+
+ my $price = 100 + int rand 9900 ;
+
+ my $delta = -1000 + int rand 2000 ;
+
+ my $dbi_msg = Stem::Msg->new(
+
+ 'to' => $self->{'dbi_addr'},
+ 'from' => $self->{'reg_name'},
+ 'type' => 'cmd',
+ 'cmd' => 'execute',
+ 'reply_type' => 'insert_done',
+ 'data' => {
+ statement => 'insert_tick',
+ bind => [ $ticker, $price, $delta ],
+ },
+ );
+
+#print $dbi_msg->dump( 'SEND' ) ;
+ $dbi_msg->dispatch() ;
+
+ return ;
+}
+
+sub insert_done_in {
+
+ my( $self, $msg ) = @_ ;
+
+#print $msg->dump( 'DONE' ) ;
+
+ if ( $self->{'send_cnt'} ) {
+
+ $self->send_ticker_msgs( 1 ) ;
+ }
+
+ if ( ++$self->{'inserted_cnt'} >= $self->{'go_max_cnt'} ) {
+
+ my $data = $msg->data() ;
+
+ die "insert_done_in: $$data" unless ref $data eq 'HASH' ;
+
+ my $time_delta = sprintf( "%8.4f",
+ gettimeofday() - $self->{'start_time'} ) ;
+
+ my $rows_per_second = $self->{'inserted_cnt'} / $time_delta ;
+
+ my $done_msg = Stem::Msg->new(
+ 'to' => $self->{'go_from_addr'},
+ 'from' => $self->{'reg_name'},
+ 'type' => 'response',
+ 'data' => <<DATA,
+inserted $self->{'inserted_cnt'} rows in $time_delta seconds
+$rows_per_second rows per second
+with $self->{'parallel_cnt'} inserts in parallel
+last row ID $data->{'insert_id'}
+DATA
+ ) ;
+
+ $done_msg->dispatch() ;
+
+ return ;
+ }
+
+
+ return ;
+}
+
+1 ;
--- /dev/null
+# File: Stem/Log.pm
+
+# This file is part of Stem.
+# Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
+
+# Stem is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# Stem is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with Stem; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# For a license to use the Stem under conditions other than those
+# described here, to purchase support for this software, or to purchase a
+# commercial warranty contract, please contact Stem Systems at:
+
+# Stem Systems, Inc. 781-643-7504
+# 79 Everett St. info@stemsystems.com
+# Arlington, MA 02474
+# USA
+
+use strict ;
+
+use Stem::Log::Entry ;
+use Stem::Log::File ;
+
+my %logs ;
+
+package Stem::Log ;
+
+use Stem::Trace 'log' => 'stem_status', 'sub' => 'TraceStatus' ;
+use Stem::Trace 'log' => 'stem_error' , 'sub' => 'TraceError' ;
+
+
+use Data::Dumper ;
+
+use Stem::Vars ;
+
+Stem::Route::register_class( __PACKAGE__, 'log' ) ;
+
+my $attr_spec = [
+
+ {
+ 'name' => 'name',
+ 'required' => 1,
+ 'help' => <<HELP,
+Name of this logical log.
+HELP
+ },
+ {
+ 'name' => 'file',
+ 'class' => 'Stem::Log::File',
+ 'help' => <<HELP,
+The Stem::Log::File object that will create and manage a physical log file.
+HELP
+ },
+ {
+ 'name' => 'format',
+ 'default' => '%T',
+ 'help' => <<HELP,
+Format to print entries for this logical log. See elsewhere in this
+document for the details of the sprintf-like format'
+HELP
+ },
+ {
+ 'name' => 'strftime',
+ 'default' => '%C',
+ 'help' => <<HELP,
+Format passed to strftime to print the %f entry format.
+HELP
+ },
+ {
+ 'name' => 'use_gmt',
+ 'default' => 1,
+ 'type' => 'boolean',
+ 'help' => <<HELP,
+Make strftime use gmtime instead of localtime to break the log entry
+timestamp into its parts.
+HELP
+ },
+ {
+ 'name' => 'filters',
+ 'help' => <<HELP,
+List of key/value pairs. The keys are either rules, actions or 'flag'.
+The value is passed to the function for the key. Use a list for complex values.
+HELP
+ },
+
+] ;
+
+
+sub new {
+
+ my( $class ) = shift ;
+
+ my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
+ return $self unless ref $self ;
+
+ $logs{ $self->{'name'} } = $self ;
+
+ return ;
+}
+
+# table to convert filter keys to code refs to execute
+# these are all passed the $entry hash ref, the filter arg and the log object
+
+my %filter_to_code = (
+
+ 'match_text' => sub { $_[0]->{'text'} =~ /$_[1]/ },
+ 'match_label' => sub { $_[0]->{'label'} =~ /$_[1]/ },
+
+ 'eq_level' => sub { $_[0]->{'level'} == $_[1] },
+ 'lt_level' => sub { $_[0]->{'level'} < $_[1] },
+ 'le_level' => sub { $_[0]->{'level'} <= $_[1] },
+ 'gt_level' => sub { $_[0]->{'level'} > $_[1] },
+ 'ge_level' => sub { $_[0]->{'level'} >= $_[1] },
+
+ 'env_eq_level' => sub { $_[0]->{'level'} == ( $Env{ $_[1] } || 0 ) },
+ 'env_lt_level' => sub { $_[0]->{'level'} > ( $Env{ $_[1] } || 0 ) },
+ 'env_le_level' => sub { $_[0]->{'level'} >= ( $Env{ $_[1] } || 0 ) },
+ 'env_gt_level' => sub { $_[0]->{'level'} < ( $Env{ $_[1] } || 0 ) },
+ 'env_ge_level' => sub { $_[0]->{'level'} <= ( $Env{ $_[1] } || 0 ) },
+
+ 'file' => \&_action_file,
+ 'stdout' => \&_action_stdout,
+ 'stderr' => \&_action_stderr,
+ 'dev_tty' => \&_action_dev_tty,
+ 'console' => \&_action_console,
+# 'msg' => \&_action_msg,
+ 'write' => \&_action_write,
+ 'wall' => \&_action_wall,
+ 'email' => \&_action_email,
+ 'page' => \&_action_page,
+ 'forward' => \&_action_forward,
+
+ 'custom' => \&_custom_filter,
+) ;
+
+my %flag_to_code = (
+
+ 'set' => sub { $_[0]->{'flag'} = 1 },
+ 'clear' => sub { $_[0]->{'flag'} = 0 },
+ 'invert' => sub { $_[0]->{'flag'} = ! $_[0]->{'flag'} },
+ 'inverted_test' => sub { $_[0]->{'invert_test'} = 1 },
+ 'normal_test' => sub { $_[0]->{'invert_test'} = 0 },
+ 'or' => sub { $_[0]->{'or'} = 1 },
+ 'and' => sub { $_[0]->{'or'} = 0 },
+) ;
+
+sub submit {
+
+ my( $self, $entry ) = @_ ;
+
+ $entry->{'format'} = $self->{'format'} ;
+ $entry->{'strftime'} = $self->{'strftime'} ;
+ $entry->{'use_gmt'} = $self->{'use_gmt'} ;
+
+ my $filter_list = $self->{'filters'} ;
+
+ unless ( $filter_list ) {
+
+# no filter so the default is to log to the file
+
+ _action_file( $entry, 0, $self ) ;
+
+ return ;
+ }
+
+# start with all actions enabled
+
+ $entry->{'flag'} = 1 ;
+
+# scan the filter list by pairs
+
+ for( my $i = 0 ; $i < @{$filter_list} ; $i += 2 ) {
+
+ my ( $filter_key, $filter_arg ) =
+ @{$filter_list}[$i, $i + 1] ;
+
+# handle the flag operations first.
+
+ if ( $filter_key eq 'flag' ) {
+
+ if ( my $code = $flag_to_code{ $filter_arg } ) {
+
+ $code->( $entry ) ;
+ }
+
+ next ;
+ }
+
+# skip this filter rule/action if the flag is false
+
+ next unless $entry->{'flag'} && ! $entry->{'invert_test'} ;
+
+# check for and remove a 'not_' prefix
+
+ my $not = $filter_key =~ s/^not_(\w+)$/$1/ ;
+
+#print "FILT $filter_key $filter_arg\n" ;
+
+ my $code = $filter_to_code{ $filter_key } ;
+
+ next unless $code ;
+
+# execute the rule/action code
+
+ my $flag_val = $code->( $entry, $filter_arg, $self ) ;
+
+# don't mung the flag unless we get a boolean return
+
+ next unless defined( $flag_val ) ;
+
+# invert the returned flag value if needed
+
+ $flag_val = ! $flag_val if $not ;
+
+# do the right boolean op
+
+ if ( $entry->{'or'} ) {
+
+ $entry->{'flag'} ||= $flag_val ;
+ }
+ else {
+
+ $entry->{'flag'} &&= $flag_val ;
+ }
+ }
+}
+
+
+sub _format_entry {
+
+ my( $entry ) = @_ ;
+
+ my $formatted = $entry->{'format'} ;
+
+ $formatted =~ s/%(.)/_format_field( $entry, $1 )/seg ;
+
+ return $formatted ;
+}
+
+my %letter_to_key = (
+
+ 'T' => 'text',
+ 't' => 'time',
+ 'L' => 'label',
+ 'l' => 'level',
+ 'H' => 'hub_name',
+ 'h' => 'host_name',
+ 'P' => 'program_name',
+) ;
+
+sub _format_field {
+
+ my( $entry, $letter ) = @_ ;
+
+ if ( my $key = $letter_to_key{ $letter } ) {
+
+ return $entry->{$key} ;
+ }
+
+ if ( $letter eq 'f' ) {
+
+ require POSIX ;
+
+ $entry->{'formatted_time'} ||= do {
+
+ my @times = ( $entry->{'use_gmt'} ) ?
+ gmtime( $entry->{'time'} ) :
+ localtime( $entry->{'time'} ) ;
+
+ POSIX::strftime( $entry->{'strftime'}, @times ) ;
+ } ;
+
+ return $entry->{'formatted_time'} ;
+ }
+
+ return $letter ;
+}
+
+sub _action_file {
+
+ my( $entry, $arg, $log_obj ) = @_ ;
+
+ my $file = $log_obj->{'file'} ;
+
+ $file or return ;
+
+ $entry->{'formatted'} ||= _format_entry( $entry ) ;
+
+ $file->write( $entry->{'formatted'} ) ;
+
+ return ;
+}
+
+sub _action_stdout {
+
+ my( $entry ) = shift ;
+
+ $entry->{'formatted'} ||= _format_entry( $entry ) ;
+
+ print STDOUT $entry->{'formatted'} ;
+
+ return ;
+}
+
+sub _action_stderr {
+
+ my( $entry ) = shift ;
+
+ $entry->{'formatted'} ||= _format_entry( $entry ) ;
+
+ print STDERR $entry->{'formatted'} ;
+
+ return ;
+}
+
+sub _action_write {
+
+ my( $entry, $arg ) = @_ ;
+
+ $entry->{'formatted'} ||= _format_entry( $entry ) ;
+
+ my @users = ref $arg ? @{$arg} : $arg ;
+
+ foreach my $user ( @users ) {
+
+ system <<SYS ;
+/bin/echo '$entry->{'formatted'}' | write $user >/dev/null 2>&1 &
+SYS
+ }
+
+ return ;
+}
+
+sub _action_wall {
+
+ my( $entry ) = shift ;
+
+ $entry->{'formatted'} ||= _format_entry( $entry ) ;
+
+
+ system <<SYS ;
+/bin/echo '$entry->{'formatted'}' | wall &
+SYS
+
+ return ;
+}
+
+# handle to write log entries to /dev/tty
+
+my $tty_fh ;
+
+sub _action_dev_tty {
+
+ my( $entry ) = shift ;
+
+ $tty_fh ||= IO::File->new( ">/dev/tty" ) ;
+
+ unless( $tty_fh ) {
+
+ warn "can't open log file /dev/tty $!" ;
+ return ;
+ }
+
+ $entry->{'formatted'} ||= _format_entry( $entry ) ;
+
+ print $tty_fh $entry->{'formatted'} ;
+
+ return ;
+}
+
+sub _action_console {
+
+ my( $entry ) = shift ;
+
+ $entry->{'formatted'} ||= _format_entry( $entry ) ;
+
+ return unless Stem::Console->can( 'write' ) ;
+
+ Stem::Console->write( $entry->{'formatted'} ) ;
+
+ return ;
+}
+
+sub _action_forward {
+
+ my( $entry, $arg ) = @_ ;
+
+ my @logs = ref $arg ? @{$arg} : $arg ;
+
+ my $entry_obj = $entry->{'entry_obj'} ;
+
+ $entry_obj->submit( @logs ) ;
+
+ return ;
+}
+
+sub _action_email {
+
+ my( $entry, $arg ) = @_ ;
+
+ $entry->{'formatted'} ||= _format_entry( $entry ) ;
+
+ my ( $email_addr, $subject ) = ( ref $arg ) ?
+ @{$arg} : ( $arg, 'Stem::Log' ) ;
+
+#print "EMAIL $email_addr: $subject\n" ;
+
+ require Mail::Send ;
+
+ my $mail = Mail::Send->new(
+ 'To' => $email_addr,
+ 'Subject' => $subject
+ ) ;
+
+ my $fh = $mail->open();
+
+ $fh->print( $entry->{'formatted'} ) ;
+
+ $fh->close;
+
+ return ;
+}
+
+sub _custom_filter {
+
+ my( $entry, $arg ) = @_ ;
+
+#####
+# do this
+#####
+
+ return ;
+}
+
+sub find_log {
+
+ my ( $log_name ) = @_ ;
+
+ return( $logs{ $log_name } ) ;
+}
+
+sub status_cmd {
+
+ my $status_text .= sprintf( "%-20s%-40s%10s\n",
+ "Logical Log",
+ "Physical File",
+ "Size" ) ;
+ $status_text .= sprintf "-" x 70 . "\n";
+
+ foreach my $log_name ( sort keys %logs ) {
+
+ my $ref = $logs{$log_name} ;
+
+ $status_text .= sprintf "%-20s%-40s%10s\n",
+ $log_name,
+ $ref->{'file'}{'path'},
+ $ref->{'file'}{'size'} ;
+ }
+
+ $status_text .= "\n\n" ;
+
+ return $status_text ;
+}
+
+1 ;
--- /dev/null
+# File: Stem/Log/Entry.pm
+
+# This file is part of Stem.
+# Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
+
+# Stem is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# Stem is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with Stem; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# For a license to use the Stem under conditions other than those
+# described here, to purchase support for this software, or to purchase a
+# commercial warranty contract, please contact Stem Systems at:
+
+# Stem Systems, Inc. 781-643-7504
+# 79 Everett St. info@stemsystems.com
+# Arlington, MA 02474
+# USA
+
+use strict ;
+
+use Stem::Log ;
+
+package Stem::Log::Entry ;
+
+Stem::Route::register_class( __PACKAGE__, 'entry' ) ;
+
+
+my $attr_spec = [
+
+ {
+ 'name' => 'text',
+ 'default' => '',
+ 'help' => <<HELP,
+Text for this log entry. Can be filtered with the rule 'match_text'.
+HELP
+ },
+ {
+ 'name' => 'label',
+ 'default' => 'info',
+ 'help' => <<HELP,
+Label for this log entry. This is used to tag log entries from
+different sources. Can be filtered with the rule 'match_label'.
+HELP
+ },
+ {
+ 'name' => 'level',
+ 'default' => '1',
+ 'help' => <<HELP,
+Severity level for this log entry. It is an integer with 0 being the
+most severe level and 10 the lowest (this maps to the levels of
+syslog). There are several rules which can filter based on the level.
+HELP
+ },
+ {
+ 'name' => 'logs',
+ 'type' => 'list',
+ 'help' => <<HELP,
+This is a list of logical logs where this entry is submitted. The
+first one is considered the original log. If this is not passed, then
+the entry must be explicitly submitted by the submit method.
+HELP
+ },
+] ;
+
+
+
+sub new {
+
+ my( $class ) = shift ;
+
+ my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
+ return $self unless ref $self ;
+
+ $self->{'time'} = time() ;
+ $self->{'hub_name'} = $Stem::Vars::Hub_name ;
+ $self->{'host_name'} = $Stem::Vars::Host_name ;
+ $self->{'program_name'} = $Stem::Vars::Program_name ;
+
+ if ( my $logs_attr = $self->{'logs'} ) {
+
+ $self->submit( @{$logs_attr} ) ;
+ }
+
+ return $self ;
+}
+
+sub submit {
+
+ my( $self, @logs ) = @_ ;
+
+ foreach my $log_name ( @logs ) {
+
+#print "LOG [$log_name]\n" ;
+ if ( $log_name =~ /^(\w+):(\w+)$/ ) {
+
+ my $to_hub = $1 ;
+ my $to_log = $2 ;
+
+ my $log_msg = Stem::Msg->new(
+ 'to' => "$to_hub:" . __PACKAGE__,
+ 'from' => __PACKAGE__,
+ 'type' => 'log',
+ 'log' => $to_log,
+ 'data' => $self,
+ ) ;
+
+#print $log_msg->dump( 'LOG out' ) ;
+
+
+ $log_msg->dispatch() ;
+
+ next ;
+ }
+
+ my $log_obj = Stem::Log::find_log( $log_name ) ;
+
+ next unless $log_obj ;
+
+
+ my $entry_copy ||= { %{$self} } ;
+
+ $entry_copy->{'log_name'} = $log_name ;
+ $entry_copy->{'orig_log_name'} ||= $log_name ;
+ $entry_copy->{'entry_obj'} = $self ;
+
+ $log_obj->submit( $entry_copy ) ;
+ }
+}
+
+# this method is how a remote log message is delivered locally
+
+sub log_in {
+
+ my( $class, $msg ) = @_ ;
+
+ my $entry = $msg->data() ;
+
+ print "$entry\n" unless ref $entry ;
+
+#print $msg->dump( 'LOG in' ) ;
+
+ $entry->submit( $msg->log() ) ;
+
+ return ;
+}
+
+1 ;
--- /dev/null
+# File: Stem/Log/File.pm
+
+# This file is part of Stem.
+# Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
+
+# Stem is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# Stem is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with Stem; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# For a license to use the Stem under conditions other than those
+# described here, to purchase support for this software, or to purchase a
+# commercial warranty contract, please contact Stem Systems at:
+
+# Stem Systems, Inc. 781-643-7504
+# 79 Everett St. info@stemsystems.com
+# Arlington, MA 02474
+# USA
+
+use strict ;
+
+use IO::File ;
+use File::Basename ;
+
+
+package Stem::Log::File ;
+
+#########################
+#########################
+# add stuff for file rotation, number suffix, etc.
+#########################
+#########################
+
+my $attr_spec_log = [
+
+ {
+ 'name' => 'path',
+ 'required' => 1,
+ 'help' => <<HELP,
+The path for the physical log file
+HELP
+ },
+ {
+ 'name' => 'strftime',
+ 'default' => '%Y%m%d%H%M%S',
+ 'help' => <<HELP,
+Format passed to strftime to print the log file suffix timestamp
+HELP
+ },
+ {
+ 'name' => 'use_gmt',
+ 'default' => 1,
+ 'type' => 'boolean',
+ 'help' => <<HELP,
+Make strftime use gmtime instead of localtime for the suffix timestamp
+HELP
+ },
+
+ {
+ 'name' => 'rotate',
+ 'type' => 'hash',
+ 'help' => <<HELP,
+This is a list of option key/value pairs that can be applied to log rotation.
+HELP
+ },
+
+] ;
+
+
+sub new {
+
+ my( $class ) = shift ;
+
+ my $self = Stem::Class::parse_args( $attr_spec_log, @_ ) ;
+ return $self unless ref $self ;
+
+ if ( my $rotate_options = $self->{'rotate'} ) {
+
+ if ( ref $rotate_options eq 'ARRAY' ) {
+
+ $self->{'rotate'} = { @{$rotate_options} } ;
+ }
+ }
+
+ $self->{'base_path'} = $self->{'path'} ;
+ ( $self->{'log_dir'}, $self->{'file_name'} ) =
+ File::Basename::fileparse( $self->{'path'} ) ;
+
+ my $err = $self->_open_file() ;
+ return $err if $err ;
+
+ return( $self ) ;
+}
+
+
+sub write {
+
+ my( $self, $text ) = @_ ;
+
+ $self->{'fh'}->print( $text ) ;
+
+ $self->{'size'} += length( $text ) ;
+
+ my $rotate_options = $self->{'rotate'} ;
+
+ if ( $rotate_options &&
+ $self->{'size'} >= $rotate_options->{'max_size'} ) {
+
+ $self->_rotate() ;
+ }
+}
+
+sub status_cmd {
+
+
+}
+
+sub rotate_cmd {
+
+ my ( $self ) = @_ ;
+
+ $self->_rotate() ;
+}
+
+sub _rotate {
+
+ my ( $self ) = @_ ;
+
+ my $fh = $self->{'fh'} ;
+
+ close( $fh ) ;
+
+ $self->_open_file() ;
+}
+
+
+sub _open_file {
+
+ my ( $self ) = @_ ;
+
+ my $open_path = $self->{'base_path'} ;
+
+ if ( $self->{'rotate'} ) {
+
+ my $suffix = $self->_get_last_suffix() ||
+ $self->_generate_suffix() ;
+
+
+ $open_path .= ".$suffix" ;
+ }
+
+ $self->{'open_path'} = $open_path ;
+
+ my $fh = IO::File->new( ">>$open_path" ) or
+ return "Can't append to log file '$open_path' $!" ;
+
+ $self->{'size'} = -s $fh ;
+
+ $fh->autoflush( 1 ) ;
+
+ $self->{'fh'} = $fh ;
+
+ return ;
+}
+
+sub _get_last_suffix {
+
+ my ( $self ) = @_ ;
+
+ my $log_dir = $self->{'log_dir'} ;
+ my $file_name = $self->{'file_name'} ;
+
+ local( *DH ) ;
+
+ opendir( DH, $log_dir ) || return '' ;
+
+ my @files = sort grep { /^$file_name/ } readdir(DH) ;
+
+# return the latest file suffix
+
+ if ( @files ) {
+
+ return $1 if $files[-1] =~ /\.(\d+$)/ ;
+ }
+
+ return '' ;
+}
+
+
+sub _generate_suffix {
+
+ my ( $self ) = @_ ;
+
+ require POSIX ;
+
+ my @time = ( $self->{'use_gmt'} ) ? gmtime : localtime ;
+
+ return POSIX::strftime( $self->{'strftime'}, @time ) ;
+}
+
+1 ;
--- /dev/null
+# File: Stem/Log/Tail.pm
+
+# This file is part of Stem.
+# Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
+
+# Stem is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# Stem is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with Stem; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# For a license to use the Stem under conditions other than those
+# described here, to purchase support for this software, or to purchase a
+# commercial warranty contract, please contact Stem Systems at:
+
+# Stem Systems, Inc. 781-643-7504
+# 79 Everett St. info@stemsystems.com
+# Arlington, MA 02474
+# USA
+
+package Stem::Log::Tail ;
+
+use strict ;
+use IO::Seekable ;
+use Data::Dumper ;
+
+use Stem::Trace 'log' => 'stem_status', 'sub' => 'TraceStatus' ;
+use Stem::Trace 'log' => 'stem_error' , 'sub' => 'TraceError' ;
+
+my $attr_spec = [
+
+ {
+ 'name' => 'path',
+ 'required' => 1,
+ 'help' => <<HELP,
+This is the full path to the file we want to tail.
+HELP
+ },
+
+ {
+ 'name' => 'data_log',
+ 'required' => 1,
+ 'help' => <<HELP,
+This is the log which gets sent the data log entries.
+HELP
+ },
+
+ {
+ 'name' => 'status_log',
+ 'help' => <<HELP,
+This is the log which gets sent the status log entries.
+These include things like: Log has been rotated, deleted, moved, etc...
+HELP
+ },
+ {
+ 'name' => 'label',
+ 'default' => 'tail',
+ 'help' => <<HELP,
+Label to tag tailed log entry.
+HELP
+ },
+ {
+ 'name' => 'level',
+ 'default' => '5',
+ 'help' => <<HELP,
+Severity level for this tailed log entry.
+HELP
+ },
+ {
+ 'name' => 'interval',
+ 'help' => <<HELP,
+This specifies (in seconds) how often we check the log file for new
+data. If this is not specified, you need to call the tail_cmd method
+to check for new data.
+HELP
+ },
+ {
+ 'name' => 'delay',
+ 'default' => 10,
+ 'help' => <<HELP,
+This specifies (in seconds) how long the delay is before the
+first repeated checking of the log file for new data.
+HELP
+ },
+] ;
+
+
+sub new {
+
+ my( $class ) = shift ;
+
+ my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
+ return $self unless ref $self ;
+
+print "TAIL INT $self->{'interval'}\n" ;
+
+ if ( my $interval = $self->{'interval'} ) {
+
+ $self->{'timer'} = Stem::Event::Timer->new(
+ 'object' => $self,
+ 'method' => 'tail_cmd',
+ 'interval' => $interval,
+ 'delay' => $self->{'delay'},
+ 'repeat' => 1,
+ 'hard' => 1,
+ ) ;
+
+print "TIMER $self->{'timer'}\n" ;
+
+ }
+
+ $self->{'prev_size'} = 0 ;
+ $self->{'prev_mtime'} = 0 ;
+ $self->{'prev_inode'} = -1 ;
+
+ return( $self ) ;
+}
+
+sub tail_cmd {
+
+ my( $self ) = @_ ;
+
+print "TAILING\n" ;
+
+ local( *LOG ) ;
+
+ my $path = $self->{'path'} ;
+
+ unless( open( LOG, $path ) ) {
+
+ return if $self->{'open_failed'} ;
+ $self->{'open_failed'} = 1 ;
+
+ if ( my $status_log = $self->{'status_log'} ) {
+
+ Stem::Log::Entry->new(
+ 'logs' => $status_log,
+ 'label' => 'LogTail status',
+ 'text' =>
+ "LogTail: missing log $path $!\n",
+ ) ;
+ }
+ return ;
+ }
+
+ $self->{'open_failed'} = 0 ;
+
+ my( $inode, $size, $mtime ) = (stat LOG)[1, 7, 9] ;
+
+ TraceStatus "size $size mtime $mtime $inode" ;
+
+ my $prev_inode = $self->{'prev_inode'} ;
+ my $prev_size = $self->{'prev_size'} ;
+
+ if ( $prev_inode == -1 ) {
+
+ $self->{'prev_inode'} = $inode ;
+
+ if ( my $status_log = $self->{'status_log'} ) {
+
+ Stem::Log::Entry->new(
+ 'logs' => $status_log,
+ 'level' => 6,
+ 'label' => 'LogTail status',
+ 'text' =>
+ "LogTail: first open of $path\n",
+ ) ;
+ }
+ }
+ elsif ( $inode != $prev_inode ) {
+
+ $self->{'prev_inode'} = $inode ;
+
+ if ( my $status_log = $self->{'status_log'} ) {
+
+ Stem::Log::Entry->new(
+ 'logs' => $status_log,
+ 'level' => 6,
+ 'label' => 'LogTail status',
+ 'text' =>
+ "LogTail: $path has moved\n",
+ ) ;
+ }
+
+# tail the entire file as it is new
+
+ $prev_size = 0 ;
+
+ }
+ elsif ( $size < $prev_size ) {
+
+ if ( my $status_log = $self->{'status_log'} ) {
+
+ Stem::Log::Entry->new(
+ 'logs' => $status_log,
+ 'level' => 6,
+ 'label' => 'LogTail status',
+ 'text' =>
+ "LogTail: $path has shrunk\n",
+ ) ;
+ }
+
+# tail the entire file as it has shrunk
+
+ $prev_size = 0 ;
+ }
+ elsif ( $size == $prev_size ) {
+
+ TraceStatus "no changes" ;
+ return ;
+ }
+
+ $self->{'prev_size'} = $size ;
+
+ my $delta_size = $size - $prev_size ;
+
+ return unless $delta_size ;
+
+ my $read_buf ;
+
+ sysseek( *LOG, $prev_size, SEEK_SET ) ;
+ sysread( *LOG, $read_buf, $delta_size ) ;
+
+ Stem::Log::Entry->new(
+ 'logs' => $self->{'data_log'},
+ 'level' => $self->{'level'},
+ 'label' => $self->{'label'},
+ 'text' => $read_buf,
+ ) ;
+
+ return ;
+}
+
+1 ;
--- /dev/null
+# File: Stem/Msg.pm
+
+# This file is part of Stem.
+# Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
+
+# Stem is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# Stem is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with Stem; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# For a license to use the Stem under conditions other than those
+# described here, to purchase support for this software, or to purchase a
+# commercial warranty contract, please contact Stem Systems at:
+
+# Stem Systems, Inc. 781-643-7504
+# 79 Everett St. info@stemsystems.com
+# Arlington, MA 02474
+# USA
+
+package Stem::Msg ;
+
+use strict ;
+use Carp ;
+
+use Stem::Route qw( lookup_cell ) ;
+use Stem::Trace 'log' => 'stem_status', 'sub' => 'TraceStatus' ;
+use Stem::Trace 'log' => 'stem_error' , 'sub' => 'TraceError' ;
+use Stem::Trace 'log' => 'stem_msg' , 'sub' => 'TraceMsg' ;
+
+my $msg_id = 0;
+
+my $attr_spec = [
+
+ {
+ 'name' => 'type',
+ 'help' => <<HELP,
+This is the type of the message. It is used to select the delivery method in
+the addressed Cell.
+HELP
+ },
+
+ {
+ 'name' => 'cmd',
+ 'help' => <<HELP,
+This is used for the delivery method if the message type is 'cmd'.
+HELP
+ },
+ {
+ 'name' => 'reply_type',
+ 'default' => 'response',
+ 'help' => <<HELP,
+This is the type that will be used in a reply message.
+HELP
+ },
+
+ {
+ 'name' => 'data',
+ 'help' => <<HELP,
+This is the data the message is carrying. It should (almost) always be
+a reference.
+HELP
+ },
+
+ {
+ 'name' => 'log',
+ 'help' => <<HELP,
+This is the name of the log in a log type message.
+HELP
+ },
+
+ {
+ 'name' => 'status',
+ 'help' => <<HELP,
+This is the status in a status message.
+HELP
+ },
+
+ {
+ 'name' => 'ack_req',
+ 'type' => 'boolean',
+ 'help' => <<HELP,
+This flag means when this message is delivered, a 'msg_ack' message
+sent back as a reply.
+HELP
+ },
+
+ {
+ 'name' => 'in_portal',
+ 'help' => <<HELP,
+This is the name of the Stem::Portal that received this message.
+HELP
+ },
+ {
+ 'name' => 'msg_id',
+ 'help' => <<HELP,
+A unique id for the message.
+HELP
+ },
+ {
+ 'name' => 'reply_id',
+ 'help' => <<HELP,
+For replies, this is the msg_id of the message being replied to.
+HELP
+ },
+] ;
+
+# get the plain (non-address) attributes for the AUTOLOAD and the
+# message dumper
+
+my %is_plain_attr = map { $_->{'name'}, 1 } @{$attr_spec} ;
+
+# add the address types and parts to our attribute spec with callbacks
+# for parsing
+
+# lists of the address types and parts
+
+my @addr_types = qw( to from reply_to ) ;
+my @addr_parts = qw( hub cell target ) ;
+
+# these are used to grab the types and parts from the method names in AUTOLOAD
+
+my $type_regex = '(' . join( '|', @addr_types ) . ')' ;
+my $part_regex = '(' . join( '|', @addr_parts ) . ')' ;
+
+# build all the accessor methods as closures
+
+{
+ no strict 'refs' ;
+
+ foreach my $attr ( map $_->{'name'}, @{$attr_spec} ) {
+
+ *{$attr} = sub {
+
+ $_[0]->{$attr} = $_[1] if @_ > 1 ;
+ return $_[0]->{$attr}
+ } ;
+ }
+
+ foreach my $type ( @addr_types ) {
+
+ *{$type} = sub {
+ my $self = shift ;
+ $self->{ $type } = shift if @_ ;
+ return $self->{ $type } ;
+ } ;
+
+##########
+# WORKAROUND
+# this array seems to be needed. i found a bug when i used
+# a scalar and bumped it. the closures all had the value of 3.
+##########
+
+ my @part_nums = ( 0, 1, 2 ) ;
+
+ foreach my $part ( @addr_parts ) {
+
+ my $part_num = shift @part_nums ;
+
+ *{"${type}_$part"} = sub {
+ my $self = shift ;
+
+# split the address for this type of address (to,from,reply_to)
+
+ my @parts = split_address( $self->{$type} ) ;
+
+
+ if ( @_ ) {
+
+ $parts[ $part_num ] = shift ;
+
+ $self->{$type} =
+ make_address_string( @parts ) ;
+ }
+#print "PART $type $part_num [$parts[ $part_num ]]\n" if $type eq 'from' ;
+
+ return $parts[ $part_num ] ;
+ } ;
+ }
+ }
+}
+
+# used for faster parsing.
+
+my @attrs = qw( to from reply_to type cmd reply_type log data ) ;
+
+sub new {
+
+ my( $class ) = shift ;
+
+# my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
+# return $self unless ref $self ;
+
+#print "A [$_]\n" for @_ ;
+
+ my %args = @_ ;
+
+#use YAML ;
+#print Dump \%args ;
+
+ my $self = bless { map { exists $args{$_} ?
+ ( $_ => $args{$_} ) : () } @attrs } ;
+
+#print $self->dump( 'NEW' ) ;
+
+ $self->{'type'} = 'cmd' if exists $self->{'cmd'} ;
+
+ $self->{'msg_id'} ||= $class->_new_msg_id;
+
+# TraceMsg "MSG: [$_] => [$args{$_}]\n" for sort keys %args ;
+
+# TraceMsg $self->dump( 'new MSG' ) ;
+
+ return( $self ) ;
+}
+
+sub _new_msg_id {
+
+ my( $class ) = shift ;
+
+ $msg_id = 0 if $msg_id == 2 ** 31;
+
+ return ++$msg_id;
+}
+
+sub clone {
+
+ my( $self ) = shift ;
+
+ my $msg = Stem::Msg->new(
+ ( map { exists $self->{$_} ?
+ ( $_, $self->{$_} ) : () }
+ @addr_types, keys %is_plain_attr ),
+ @_
+ ) ;
+
+# TraceMsg $self->dump( 'self' ) ;
+# TraceMsg $msg->dump( 'clone' ) ;
+
+ return $msg ;
+}
+
+sub split_address {
+
+# return an empty address if no input
+
+ return( '', '', '' ) unless @_ && $_[0] ;
+
+# parse out the address parts so
+
+# the cell part can be a token or a class name with :: between tokens.
+# delimiter can be /, @, -, or : with : being the convention
+# this is how triplets
+# hub:cell:target
+
+#print "SPLIT IN [$_[0]]\n" ;
+
+ $_[0] =~ m{
+ ^ # beginning of string
+ (?: # group /hub:/
+ (\w*) # grab /hub/
+ ([:/@-]) # grab any common delimiter
+ )? # hub: is optional
+ ( # grab /cell/
+ (?:\w+|::)+ # group cell (token or class name)
+ ) # /cell/ is required
+ (?: # group /:target/
+ \2 # match first delimiter
+ (\w*) # grab /target/
+ )? # :target is optional
+ $}x # end of string
+
+# an bad address can be checked with @_ == 1 as a proper address is
+# always 3.
+
+ or return "bad string address" ;
+
+# we return the list of hub, cell, target and give back nice null strings if
+# needed.
+
+#print "SPLIT ", join( '--', $1 || '', $3, $4 || '' ), "\n" ;
+
+ return( $1 || '', $3, $4 || '' ) ;
+}
+
+# sub address_string {
+
+# my( $addr ) = @_ ;
+
+# #use YAML ;
+# #print "ADDR [$addr]", Dump( $addr ) ;
+# return $addr unless ref $addr ;
+
+# return 'BAD ADDRESS' unless ref $addr eq 'HASH' ;
+
+# return $addr->{'cell'} if keys %{$addr} == 1 && $addr->{'cell'} ;
+
+# return join ':', map { $_ || '' } @{$addr}{qw( hub cell target ) } ;
+# }
+
+sub make_address_string {
+
+ my( $hub, $cell_name, $target ) = @_ ;
+
+ $hub = '' unless defined $hub ;
+ $target = '' unless defined $target ;
+
+ return $cell_name unless length $hub || length $target ;
+
+ return join ':', $hub, $cell_name, $target ;
+}
+
+sub reply {
+
+ my( $self ) = shift ;
+
+# TraceMsg "Reply [$self]" ;
+
+# TraceMsg $self->dump( 'reply self' ) ;
+
+#print $self->dump( 'reply self' ) ;
+
+ my $to = $self->{'reply_to'} || $self->{'from'} ;
+ my $from = $self->{'to'} ;
+
+ my $reply_msg = Stem::Msg->new(
+ 'to' => $to,
+ 'from' => $from,
+ 'type' => $self->{'reply_type'} || 'response',
+ 'reply_id' => $self->{'msg_id'},
+ @_
+ ) ;
+
+# TraceMsg $reply_msg->dump( 'new reply' ) ;
+#$reply_msg->dump( 'new reply' ) ;
+
+ return( $reply_msg ) ;
+}
+
+#####################
+#####################
+# add forward method which clones the old msg and just updates the to address.
+#
+# work needs to be done on from/origin parts and who sets them
+#####################
+#####################
+
+
+sub error {
+
+ my( $self, $err_text ) = @_ ;
+
+# TraceError "ERR [$self] [$err_text]" ;
+
+ my $err_msg = $self->reply( 'type' => 'error',
+ 'data' => \$err_text ) ;
+
+# TraceError $err_msg->dump( 'error' ) ;
+
+ return( $err_msg ) ;
+}
+
+
+########################################
+########################################
+# from/origin address will be set if none by looking up the cell that
+# is currently be called with a message. or use
+# Stem::Event::current_object which is set before every event
+# delivery.
+########################################
+########################################
+
+
+my @msg_queue ;
+
+sub dispatch {
+
+ my( $self ) = @_ ;
+
+warn( caller(), $self->dump() ) and die
+ 'Msg: No To Address' unless $self->{'to'} ;
+warn( caller(), $self->dump() ) and die
+ 'Msg: No From Address' unless $self->{'from'} ;
+
+
+# $self->deliver() ;
+# return ;
+
+# unless ( @msg_queue ) {
+ unless ( ref ( $self ) ) {
+ $self = Stem::Msg->new( @_ ) ;
+ }
+# Stem::Event::Plain->new( 'object' => __PACKAGE__,
+# 'method' => 'deliver_msg_queue' ) ;
+# }
+ return "missing to attr in msg" unless $self ->{"to"} ;
+ return "missing from attr in msg" unless $self ->{"from"} ;
+ return "missing type attr in msg" unless $self ->{"type"} ;
+ push @msg_queue, $self ;
+}
+
+sub process_queue {
+
+ while( @msg_queue ) {
+
+ my $msg = shift @msg_queue ;
+
+#print $msg->dump( 'PROCESS' ) ;
+ my $err = $msg->_deliver() ;
+
+ if ( $err ) {
+
+ my $err_text = "Undelivered:\n$err" ;
+#print $err_text, $msg->dump( 'ERR' ) ;
+ TraceError $msg->dump( "$err_text" ) ;
+
+ }
+ }
+}
+
+sub _deliver {
+
+ my( $self ) = @_ ;
+
+#print $self->dump( "DELIVER" ) ;
+
+ my( $to_hub, $cell_name, $target ) = split_address( $self->{'to'} ) ;
+
+ unless( $cell_name ) {
+
+ return <<ERR ;
+Can't deliver to bad address: '$self->{'to'}'
+ERR
+ }
+
+#print "H [$to_hub] C [$cell_name] T [$target]\n" ;
+
+ if ( $to_hub && $Stem::Vars::Hub_name ) {
+
+ if ( $to_hub eq $Stem::Vars::Hub_name ) {
+
+ if ( my $cell = lookup_cell( $cell_name, $target ) ) {
+
+ return $self->_deliver_to_cell( $cell ) ;
+ }
+
+ return <<ERR ;
+Can't find cell $cell_name in local hub $to_hub
+ERR
+ }
+
+ return $self->send_to_portal( $to_hub ) ;
+ }
+
+# no hub, see if we can deliver to a local cell
+
+ if ( my $cell = lookup_cell( $cell_name, $target ) ) {
+
+ return $self->_deliver_to_cell( $cell ) ;
+ }
+
+# see if this came in from a portal
+
+ if ( $self->{'in_portal'} ) {
+
+ return "message from another Hub can't be delivered" ;
+ }
+
+# not a local cell or named hub, send it to DEFAULT portal
+
+ my $err = $self->send_to_portal() ;
+ return $err if $err ;
+
+ return ;
+}
+
+sub send_to_portal {
+
+ my( $self, $to_hub ) = @_ ;
+
+ eval {
+
+ Stem::Portal::send_msg( $self, $to_hub ) ;
+ } ;
+
+ return "No Stem::Portal Cell was configured" if $@ ;
+
+ return ;
+}
+
+
+sub _find_local_cell {
+
+ my ( $self ) = @_ ;
+
+ my $cell_name = $self->{'to'}{'cell'} ;
+ my $target = $self->{'to'}{'target'} ;
+
+ return lookup_cell( $cell_name, $target ) ;
+}
+
+sub _deliver_to_cell {
+
+ my ( $self, $cell ) = @_ ;
+
+# set the method
+
+ my $method = ( $self->{'type'} eq 'cmd' ) ?
+ "$self->{'cmd'}_cmd" :
+ "$self->{'type'}_in" ;
+
+#print "METH: $method\n" ;
+
+# check if we can deliver there or to msg_in
+
+ unless ( $cell->can( $method ) ) {
+
+ return $self->dump( <<DUMP ) unless( $cell->can( 'msg_in' ) ) ;
+missing message delivery methods '$method' and 'msg_in'
+DUMP
+
+ $method = 'msg_in' ;
+ }
+
+ TraceMsg "MSG to $cell $method" ;
+
+ my @response = $cell->$method( $self ) ;
+
+#print "RESP [@response]\n" ;
+
+# if we get a response then return it in a message
+
+ if ( @response && $self->{'type'} eq 'cmd' ) {
+
+# make the response data a reference
+
+ my $response = shift @response ;
+ my $data = ( ref $response ) ? $response : \$response ;
+
+#print $self->dump( 'CMD msg' ) ;
+ my $reply_msg = $self->reply(
+ 'data' => $data,
+ ) ;
+
+#print $reply_msg->dump( 'AUTO REPONSE' ) ;
+
+ $reply_msg->dispatch() ;
+ }
+
+ if ( $self->{'ack_req'} ) {
+
+ my $reply_msg = $self->reply( 'type' => 'msg_ack' ) ;
+
+ $reply_msg->dispatch() ;
+ }
+
+ return ;
+}
+
+# dump a message for debugging
+
+sub dump {
+
+ my( $self, $label, $deep ) = @_ ;
+
+ require Data::Dumper ;
+
+ my $dump = '' ;
+ $label ||= 'UNKNOWN' ;
+
+ my( $file_name, $line_num ) = (caller)[1,2] ;
+
+ $dump .= <<LABEL ;
+
+>>>>
+MSG Dump at Line $line_num in $file_name
+$label = {
+LABEL
+
+ foreach my $type ( @addr_types ) {
+
+ my $addr = $self->{$type} ;
+
+ next unless $addr ;
+
+ my $addr_text = $addr || 'NONE' ;
+
+ $dump .= "\t$type\t=> $addr_text\n" ;
+ }
+
+ foreach my $attr ( sort keys %is_plain_attr ) {
+
+ next unless exists $self->{$attr} ;
+
+ my $tab = ( length $attr > 4 ) ? "" : "\t" ;
+
+ my( $val_text, $q, $ret ) ;
+
+ if ( $deep || $attr eq 'data' ) {
+
+ $val_text = Data::Dumper::Dumper( $self->{$attr} ) ;
+
+ $val_text =~ s/^.+?=// ;
+ $val_text =~ s/;\n?$// ;
+ $val_text =~ s/^\s+/\t\t/gm ;
+ $val_text =~ s/^\s*([{}])/\t$1/gm ;
+
+ $q = '' ;
+ $ret = "\n" ;
+ }
+ else {
+ $val_text = $self->{$attr} ;
+ $q = $val_text =~ /\D/ ? "'" : '' ;
+ $ret = '' ;
+ }
+
+ $dump .= <<ATTR ;
+ $attr$tab => $ret$q$val_text$q,
+ATTR
+
+ }
+
+ $dump .= "}\n<<<<\n\n" ;
+
+ return($dump) ;
+}
+
+1 ;
--- /dev/null
+# File: Stem/Packet.pm
+
+# This file is part of Stem.
+# Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
+
+# Stem is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# Stem is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with Stem; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# For a license to use the Stem under conditions other than those
+# described here, to purchase support for this software, or to purchase a
+# commercial warranty contract, please contact Stem Systems at:
+
+# Stem Systems, Inc. 781-643-7504
+# 79 Everett St. info@stemsystems.com
+# Arlington, MA 02474
+# USA
+
+package Stem::Packet ;
+
+use strict ;
+
+use Stem::Class ;
+use Stem::Codec ;
+
+my $attr_spec = [
+
+ {
+ 'name' => 'codec',
+ 'env' => 'packet_codec',
+ 'default' => 'Data::Dumper',
+ 'help' => <<HELP,
+This is the name of the Codec:: subclass that will be used in this cell
+HELP
+ },
+ {
+ 'name' => 'object',
+ 'type' => 'object',
+ 'help' => <<HELP,
+If an object is passed in, the filter will use it for callbacks
+HELP
+ },
+ {
+ 'name' => 'packet_method',
+ 'default' => 'packet_out',
+ 'help' => <<HELP,
+This method is called on the object when a packet has encoded from
+internal data
+HELP
+ },
+
+ {
+ 'name' => 'data_method',
+ 'default' => 'packet_data',
+ 'help' => <<HELP,
+This method is called on the object when a packet has been decoded
+from external data
+HELP
+ },
+
+] ;
+
+
+###########
+# This POD section is autoegenerated. Any edits to it will be lost.
+
+=head2 Constructor Attributes for Class Stem::Packet
+
+=over 4
+
+
+=item * Attribute - B<codec>
+
+=over 4
+
+
+=item Description:
+This is the name of the Codec:: subclass that will be used in this cell
+
+
+=item It B<defaults> to: Storable
+Unknown attribute env
+
+=back
+
+=item * Attribute - B<object>
+
+=over 4
+
+
+=item Description:
+If an object is passed in, the filter will use it for callbacks
+
+
+=item Its B<type> is: object
+
+=back
+
+=item * Attribute - B<packet_method>
+
+=over 4
+
+
+=item Description:
+This method is called on the object when a packet has encoded from
+internal data
+
+
+=item It B<defaults> to: packet_out
+
+=back
+
+=item * Attribute - B<data_method>
+
+=over 4
+
+
+=item Description:
+This method is called on the object when a packet has been decoded
+from external data
+
+
+=item It B<defaults> to: packet_data
+
+=back
+
+=back
+
+=cut
+
+# End of autogenerated POD
+###########
+
+sub new {
+
+ my( $class ) = shift ;
+
+
+ my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
+ return $self unless ref $self ;
+
+# my @codec_args = exists( $self->{codec} ) ?
+# ( codec => $self->{codec} ) : () ;
+
+#print "NEW PACKET CODEC $self->{codec}\n" ;
+
+ my $codec_obj = Stem::Codec->new( codec => $self->{codec} ) ;
+ return $codec_obj unless ref $codec_obj ;
+ $self->{'codec_obj'} = $codec_obj ;
+
+#print "CODEC OBJ [$codec_obj]\n" ;
+
+ return $self ;
+}
+
+my $END_MARK = "\012#END\012" ;
+my $end_mark_len = length $END_MARK ;
+
+
+sub to_packet {
+
+ my $self = shift ;
+
+ return unless @_ ;
+#use Data::Dumper ;
+#print Dumper $_[0] ;
+
+ my $codec_text = $self->{'codec_obj'}->encode( $_[0] ) ;
+
+#print Dumper $codec_text ;
+ my $size = length( ${$codec_text} ) ;
+
+# wrap the packet text with a size/codec/end pair of lines
+
+ my $packet_text = "#$size:$self->{'codec'}\012${$codec_text}$END_MARK" ;
+
+#print "PACKET TEXT [$packet_text]\n" ;
+
+ $self->_callback( 'packet_method', \$packet_text ) ;
+ return \$packet_text ;
+}
+
+sub to_data {
+
+ my( $self, $input ) = @_ ;
+
+#print "IN DATA [$input]\n" ;
+ my $buf_ref = \$self->{'buffer'} ;
+
+ ${$buf_ref} .= ( ref $input eq 'SCALAR' ) ? ${$input} : $input
+ if defined $input ;
+
+ my $codec = $self->{'codec'} ;
+
+ while( 1 ) {
+
+ unless ( $self->{'packet_len'} ) {
+
+# grab the packet_len if we can from the header line
+
+ return unless ${$buf_ref} =~
+ s/\A#(\d+):$self->{'codec'}\012// ;
+
+ $self->{'packet_len'} = $1 ;
+ }
+
+ my $packet_len = $self->{'packet_len'} || 0 ;
+
+#print "PACKET_LEN [$packet_len]\n" ;
+
+# see if we have a full packet with end line
+
+#print "IN BUF [${$buf_ref}]\n" ;
+
+ return if length( ${$buf_ref} ) < $packet_len ;
+
+# old regex method was limited to 64k bytes in a packet
+# return unless ${$buf_ref} =~ s/^(.{$packet_len})$END_MARK//s ;
+
+ return unless
+ substr( ${$buf_ref}, $packet_len, $end_mark_len ) eq $END_MARK ;
+
+# grab the packet data and end marker and delete it from the buffer
+ my $packet = substr( ${$buf_ref}, 0,
+ $packet_len + $end_mark_len, '' ) ;
+
+# delete the end marker from the packet
+
+ substr( $packet, $packet_len, $end_mark_len, '' ) ;
+
+#print "IN PACKET [$packet]\n" ;
+
+ my $decoded_data = $self->{'codec_obj'}->decode( $packet ) ;
+
+#use Data::Dumper ;
+#print "DECODED: ", Dumper( $decoded_data ) ;
+
+ $self->{'packet_len'} = 0 ;
+
+#local( $SIG{'__WARN__'} ) = sub {} ;
+
+ next if $self->_callback( 'data_method', $decoded_data ) ;
+ return( $decoded_data ) ;
+ }
+}
+
+sub _callback {
+
+ my ( $self, $method_attr, @data ) = @_ ;
+
+ my $obj = $self->{'object'} or return ;
+ my $method = $self->{$method_attr} ;
+ my $code = $obj->can( $method ) or return ;
+
+ $obj->$code( @data ) ;
+
+ return 1 ;
+}
+
+1 ;
--- /dev/null
+# File: Stem/Portal.pm
+
+# This file is part of Stem.
+# Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
+
+# Stem is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# Stem is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with Stem; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# For a license to use the Stem under conditions other than those
+# described here, to purchase support for this software, or to purchase a
+# commercial warranty contract, please contact Stem Systems at:
+
+# Stem Systems, Inc. 781-643-7504
+# 79 Everett St. info@stemsystems.com
+# Arlington, MA 02474
+# USA
+
+package Stem::Portal ;
+
+use strict ;
+use Carp ;
+use Data::Dumper ;
+
+use Stem::AsyncIO ;
+use Stem::Vars ;
+use Stem::Packet ;
+use Stem::Socket ;
+use Stem::Trace 'log' => 'stem_status', 'sub' => 'TraceStatus' ;
+use Stem::Trace 'log' => 'stem_error' , 'sub' => 'TraceError' ;
+
+my %name_to_portal ;
+my %portal_to_names ;
+
+my $default_portal ;
+
+
+Stem::Route::register_class( __PACKAGE__, 'port' ) ;
+
+my $attr_spec_portal = [
+
+ {
+ 'name' => 'reg_name',
+ 'default' => '',
+ 'help' => <<HELP,
+This is a unique name used to register this instance of a Portal.
+HELP
+ },
+ {
+ 'name' => 'server',
+ 'env' => 'server',
+ 'help' => <<HELP,
+This determines if we are a server or a client.
+If it is true, we are a server. Otherwise, we are a client.
+HELP
+ },
+ {
+ 'name' => 'sync',
+ 'type' => 'boolean',
+ 'default' => 1,
+ 'help' => <<HELP,
+Mark this as a synchronously connecting Portal. Default is syncronous
+connections, set to 0 for asynchronous. In both cases the same method
+callbacks are used.
+HELP
+ },
+ {
+ 'name' => 'port',
+ 'default' => 10_000,
+ 'env' => 'port',
+ 'help' => <<HELP,
+This determines which port we bind to if we are a server.
+This determines which port we connect to if we are a client.
+The default value is 10,000.
+HELP
+ },
+ {
+ 'name' => 'host',
+ 'default' => 'localhost',
+ 'env' => 'host',
+ 'help' => <<HELP,
+This determines which host we attach to when we are a client.
+The default value is localhost.
+HELP
+ },
+
+ {
+ 'name' => 'spawn_conf_file',
+ 'help' => <<HELP,
+This tells the portal to fork another Stem Hub and pass this value as
+the configuration file argument to run_stem. The new Hub will be
+connected to this Portal and be private to it.
+HELP
+ },
+
+ {
+ 'name' => 'spawn_conf_args',
+ 'help' => <<HELP,
+
+This tells the portal to fork another Stem Hub and pass (via a
+message) this data to the Stem::Conf as a configuration
+The new Hub will be connected to this Portal and be private
+to it.
+
+HELP
+ },
+
+
+ {
+ 'name' => 'run_stem_args',
+ 'help' => <<HELP,
+These are the command line arguments to run_stem for the spawned Hub.
+HELP
+ },
+ {
+ 'name' => 'codec',
+ 'help' => <<HELP,
+This is the sub-class that is used to convert messages to/from a byte
+stream for this portal
+HELP
+ },
+ {
+ 'name' => 'disable',
+ 'env' => 'disable',
+ 'type' => 'boolean',
+ 'help' => <<HELP,
+This flag will disable this Portal. It will not construct an object and
+no errors will be returned.
+HELP
+ },
+
+] ;
+
+sub new {
+
+ my( $class ) = shift ;
+
+ my $self = Stem::Class::parse_args( $attr_spec_portal, @_ ) ;
+ return $self unless ref $self ;
+
+ return if $self->{ 'disable' } ;
+
+ my $name = $Stem::Vars::Hub_name ;
+
+ if ( $Env{'portal_use_stdio'} ) {
+
+ return $self->new_child_portal() ;
+ }
+
+ if ( $self->{'spawn_conf_file'} || $self->{'spawn_conf_args'} ) {
+
+ return $self->new_parent_portal() ;
+ }
+
+ if ( $self->{'server'} ) {
+
+ $self->{'type'} = 'listener' ;
+ $self->{'server_name'} = $name ;
+ }
+ else {
+
+ $self->{'type'} = 'client' ;
+ $self->{'name'} = $name ;
+ }
+
+#print "REG new [$self->{'reg_name'}]\n" ;
+
+ my $sock_obj = Stem::Socket->new(
+ 'object' => $self,
+ 'host' => $self->{'host'},
+ 'port' => $self->{'port'},
+ 'server' => $self->{'server'},
+ 'sync' => $self->{'sync'},
+ ) ;
+
+ ref $sock_obj or return <<ERR ;
+Stem::Portal '$self->{'reg_name'}' tried to connect/listen to $self->{'host'}:$self->{'port'}
+$sock_obj
+ERR
+
+ $self->{'sock_obj'} = $sock_obj ;
+
+ return ;
+}
+
+sub connected {
+
+ my( $self, $connected_sock ) = @_ ;
+
+ my( $portal ) ;
+
+ TraceStatus "Portal Connected" ;
+
+ $self->{'read_fh'} = $connected_sock ;
+ $self->{'write_fh'} = $connected_sock ;
+
+ my $type = $self->{'type'} ;
+
+ if ( $type eq 'listener' ) {
+
+# fork off a new portal by making a clone of the listener portal
+
+ $portal = bless { %$self } ;
+ $portal->{'type'} = 'accepted' ;
+
+ my $name = $portal->{'server_name'} ;
+
+ $portal->{'name'} = $name ;
+
+ delete( $portal->{'sock_obj'} ) ;
+ }
+ else {
+
+#print "Portal Connected\n" ;
+
+# a client portal is just itself
+
+ $portal = $self ;
+
+#print "REG [$self->{'reg_name'}]\n" ;
+
+ if ( my $name = $self->{'reg_name'} ) {
+
+ $portal->register( $name ) ;
+ }
+
+ unless ( $default_portal ) {
+
+ $portal->register( 'DEFAULT' ) ;
+ $default_portal = $portal ;
+ }
+ }
+
+ my $err = $portal->_activate() ;
+
+ die $err if $err ;
+}
+
+my $run_stem_path ;
+
+sub new_parent_portal {
+
+ my( $self ) = @_ ;
+
+ $run_stem_path ||= do {
+
+ require Stem::Proc ;
+ require Stem::InstallConfig ;
+
+ $Stem::InstallConfig{ run_stem_path } ;
+ } ;
+
+ my $conf_file = $self->{'spawn_conf_file'} || 'portal_child' ;
+
+ my @run_stem_args = @{$self->{'run_stem_args'} || []} ;
+
+ my $proc = Stem::Proc->new(
+
+ path => $run_stem_path,
+ proc_args => [
+ 'portal_use_stdio=1',
+ @run_stem_args,
+ $conf_file,
+ ],
+ spawn_now => 1,
+ cell_attr => [
+ no_io => 1,
+ ],
+ ) ;
+
+ $self->{'proc'} = $proc ;
+
+ TraceStatus "Portal Paren" ;
+
+ $self->{'read_fh'} = $proc->read_fh() ;
+ $self->{'write_fh'} = $proc->write_fh() ;
+
+#print "REG [$self->{'reg_name'}]\n" ;
+
+ my $err = $self->_activate() ;
+
+
+ die $err if $err ;
+###########
+# $self->{'spawn_conf_args'} ) {
+#### when can we send the conf data?
+##########
+
+
+}
+
+sub new_child_portal {
+
+ my( $self ) = @_ ;
+
+ $self->{'type'} = 'child' ;
+
+
+ TraceStatus "Portal Child" ;
+
+ $self->{'read_fh'} = \*STDIN ;
+ $self->{'write_fh'} = \*STDOUT ;
+
+#print "REG [$self->{'reg_name'}]\n" ;
+
+ unless ( $default_portal ) {
+
+ $self->register( 'DEFAULT' ) ;
+ $default_portal = $self ;
+ }
+
+ if ( my $portal_name = $Env{'portal_name'} ) {
+
+ $self->register( $portal_name ) ;
+ }
+
+ my $err = $self->_activate() ;
+
+ die $err if $err ;
+}
+
+
+sub _activate {
+
+ my( $self ) = @_ ;
+
+ TraceStatus "Active portal" ;
+
+ my $aio = Stem::AsyncIO->new(
+
+ 'object' => $self,
+ 'read_fh' => $self->{'read_fh'},
+ 'write_fh' => $self->{'write_fh'},
+ 'read_method' => 'portal_data',
+ 'closed_method' => 'portal_closed',
+ ) ;
+
+ return $aio unless ref $aio ;
+
+ $self->{'aio'} = $aio ;
+
+ my $packet = Stem::Packet->new( 'codec' => $self->{'codec'} ) ;
+ return $packet unless ref $packet ;
+ $self->{'packet'} = $packet ;
+
+ my $msg = Stem::Msg->new( 'from' => "${Stem::Vars::Hub_name}:port",
+ 'type' => 'register',
+ ) ;
+
+ return $msg unless ref $msg ;
+
+ $self->write_msg( $msg ) ;
+
+ return ;
+}
+
+# this is not a method, but a class sub
+
+sub send_msg {
+
+ my ( $msg, $to_hub ) = @_ ;
+
+ $to_hub ||= 'DEFAULT' ;
+
+ my $self = $name_to_portal{ $to_hub } ;
+
+ return "unknown Portal '$to_hub'" unless $self ;
+
+ $msg->from_hub( $self->{'name'} ) unless $msg->from_hub() ;
+# $msg->from_hub( $self->{'name'} ) ;
+
+ unless( $self->{'remote_hub'} ) {
+
+ push( @{$self->{'queued_msgs'}}, $msg ) ;
+
+ return ;
+ }
+
+ $self->write_msg( $msg ) ;
+
+ return ;
+}
+
+# this is a regular method called by the above sub.
+
+sub write_msg {
+
+ my( $self, $msg ) = @_ ;
+
+ my $packet_text = $self->{'packet'}->to_packet( $msg ) ;
+
+#print "PACK SEND [$packet_text]\n" ;
+
+ $self->{'aio'}->write( $packet_text ) ;
+}
+
+sub portal_data {
+
+ my( $self, $packet_text ) = @_ ;
+
+ my $packet = $self->{'packet'} ;
+
+# parse out all messages that may be in the input data
+
+ while( my $msg = $packet->to_data( $packet_text ) ) {
+
+ $self->_portal_msg_in( $msg ) ;
+
+# no more incoming data in this callback
+
+ $packet_text = '' ;
+ }
+}
+
+sub _portal_msg_in {
+
+ my( $self, $msg ) = @_ ;
+
+ if ( $msg->type() eq 'register' ) {
+
+# register the other hub and mark this hub as connecting to it.
+
+ $self->{'remote_hub'} = $msg->from_hub() ;
+ warn( caller(), $msg->dump() ) and die
+ 'Msg Has No Remote Hub' unless $self->{'remote_hub'} ;
+ $self->register( $self->{'remote_hub'} ) ;
+
+# handle messages that got queued while the portal was down
+
+ while( my $queued_msg = shift @{$self->{'queued_msgs'}} ) {
+
+#print $queued_msg->dump( 'QUEUED' ) ;
+ $self->write_msg( $queued_msg ) ;
+ }
+
+ return ;
+ }
+
+ $msg->in_portal( $self->{'remote_hub'} ) ;
+ $msg->dispatch() ;
+}
+
+
+sub portal_closed {
+
+ my( $self ) = @_ ;
+
+#TraceStatus "Portal closed" ;
+
+ Stem::Route::unregister_cell( $self ) ;
+ my $names = $self->unregister() ;
+
+ if ( $self->{'type'} eq 'accepted' ) {
+
+# TraceStatus "client hub '$self->{'name'}' closed" ;
+
+ $self->shut_down() ;
+ return ;
+ }
+
+ my @hub_names = ref $names ? @{$names} : 'UNKNOWN' ;
+
+ Stem::Event::end_loop() ;
+
+ die "server hub [@hub_names] died" ;
+}
+
+sub shut_down {
+
+ my( $self ) = @_ ;
+
+ TraceStatus "SHUT DOWN port : ". Dumper($self);
+
+ $self->{'aio'}->shut_down() ;
+ delete @{$self}{qw( object aio )} ;
+}
+
+# this is for messages directly to this portal. messages are sent out
+# the portal via the send class method
+#
+# UNUSED so far
+
+sub msg_in {
+
+ my( $self, $msg ) = @_ ;
+
+ TraceStatus "portal msg in" ;
+}
+
+sub register {
+
+ my( $self, $name ) = @_ ;
+
+#print "NAME [$name]: ", caller(), "\n" ;
+
+ TraceStatus "portal arg: [$self] [$name]\n\t",
+ map( "<$_>", caller() ), "\n" ;
+
+ $name_to_portal{ $name } = $self ;
+ push( @{$portal_to_names{ $self }}, $name ) ;
+}
+
+sub unregister {
+
+ my( $name ) = @_ ;
+
+# convert a name to its object ;
+
+ my $portal = ref $name ? $name : $name_to_portal{ $name } ;
+
+ if ( $portal ) {
+
+ delete $name_to_portal{ $portal } ;
+
+ my $names = delete $portal_to_names{ $portal } ;
+
+ return $names ;
+
+ }
+
+ return ;
+}
+
+sub status_cmd {
+
+ my ($self, $msg ) = @_ ;
+
+#print $msg->dump( 'PORT' ) ;
+
+ my $status = <<STATUS ;
+
+Portal Status for Hub '$Stem::Vars::Hub_name'
+
+STATUS
+
+ foreach my $port_name ( sort keys %name_to_portal ) {
+
+ my $portal = $name_to_portal{ $port_name } ;
+
+ $status .= <<STATUS ;
+$port_name
+ Hub: $portal->{'remote_hub'}
+ Type: $portal->{'type'}
+
+STATUS
+
+ }
+
+ return $status ;
+}
+
+1 ;
--- /dev/null
+# File: Stem/Proc.pm
+
+# This file is part of Stem.
+# Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
+
+# Stem is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# Stem is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with Stem; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# For a license to use the Stem under conditions other than those
+# described here, to purchase support for this software, or to purchase a
+# commercial warranty contract, please contact Stem Systems at:
+
+# Stem Systems, Inc. 781-643-7504
+# 79 Everett St. info@stemsystems.com
+# Arlington, MA 02474
+# USA
+
+package Stem::Proc ;
+
+use Carp qw( cluck ) ;
+
+use strict ;
+
+use Stem::Trace 'log' => 'stem_status', 'sub' => 'TraceStatus' ;
+use Stem::Trace 'log' => 'stem_error' , 'sub' => 'TraceError' ;
+
+use IO::Socket ;
+use Symbol ;
+use Carp ;
+use POSIX qw( :sys_wait_h ) ;
+use constant EXEC_ERROR => 199 ;
+
+use Stem::Route qw( :cell ) ;
+
+use base 'Stem::Cell' ;
+
+my %pid_to_obj ;
+
+my $child_event = Stem::Event::Signal->new(
+ 'object' => bless({}),
+ 'signal' => 'CHLD'
+) ;
+
+ref $child_event or return
+ "Stem::Proc can't create SIG_CHLD handler: $child_event\n" ;
+
+my $attr_spec = [
+
+
+###############
+# if you pass in an optional object, then that will be the base for
+# all the callback methods. the message and log options will not be
+# done as they work only using the callbacks internal to Stem::Proc.
+###############
+
+ {
+ 'name' => 'reg_name',
+ 'help' => <<HELP,
+This is the name under which this Cell was registered.
+HELP
+ },
+ {
+ 'name' => 'object',
+ 'type' => 'object',
+ 'help' => <<HELP,
+This is the owner object for this Cell and it will get the callbacks.
+HELP
+ },
+ {
+ 'name' => 'path',
+ 'required' => 1,
+ 'help' => <<HELP,
+This is the path to the program to run.
+HELP
+ },
+ {
+ 'name' => 'proc_args',
+ 'default' => [],
+ 'type' => 'list',
+ 'help' => <<HELP,
+This is a list of the arguments to the program to be run.
+HELP
+ },
+ {
+ 'name' => 'spawn_now',
+ 'type' => 'boolean',
+ 'help' => <<HELP,
+This flag means to spawn the process at constructor time. Default is to
+spawn it when triggered via a message.
+HELP
+ },
+ {
+ 'name' => 'no_io',
+ 'type' => 'boolean',
+ 'help' => <<HELP,
+This flag means the process will do no standard I/O and those pipes will
+not be created.
+HELP
+ },
+ {
+ 'name' => 'no_read',
+ 'type' => 'boolean',
+ 'help' => <<HELP,
+This flag means the Cell will not read from the process and that pipe
+will not be created. (unsupported)
+HELP
+ },
+ {
+ 'name' => 'no_write',
+ 'type' => 'boolean',
+ 'help' => <<HELP,
+This flag means the Cell will not write to the process and that pipe
+will not be created. (unsupported)
+HELP
+ },
+ {
+ 'name' => 'use_stderr',
+ 'type' => 'boolean',
+ 'help' => <<HELP,
+This flag means the Cell will read from the stderr handle of the process.
+By default the stderr pipe is not created and its output comes in on stdout.
+HELP
+ },
+
+ {
+ 'name' => 'use_pty',
+ 'type' => 'boolean',
+ 'help' => <<HELP,
+This flag will cause the process to be run behind a pseudo-tty device.
+HELP
+ },
+ {
+ 'name' => 'exited_method',
+ 'default' => 'proc_ended',
+ 'help' => <<HELP,
+This method is called on the owner object when the process exits.
+HELP
+ },
+ {
+ 'name' => 'cell_attr',
+ 'class' => 'Stem::Cell',
+ 'help' => <<HELP,
+This value is the attributes for the included Stem::Cell which handles
+cloning, async I/O and pipes.
+HELP
+ },
+] ;
+
+
+sub new {
+
+ my( $class ) = shift ;
+
+ my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
+ return $self unless ref $self ;
+
+
+ my $err = $self->find_exec_path() ;
+ return $err if $err ;
+
+ $self->{ 'use_stderr' } = 0 if $self->{ 'use_pty' } ;
+
+ $err = $self->cell_set_args(
+ 'path' => $self->{'path'},
+ 'proc_args' => $self->{'proc_args'},
+ ) ;
+
+ return $err if $err ;
+
+ $self->cell_set_args( 'no_async' => 1 ) if $self->{ 'no_io' } ;
+
+###########
+# cloneable and spawn_now should be mutually exclusive
+##########
+
+ if ( $self->{'spawn_now'} ) {
+
+TraceStatus "New Spawn" ;
+
+ my $err = $self->cell_trigger();
+ return $err unless ref $err ;
+
+ $err = $self->spawn() ;
+ return $err if $err ;
+ }
+
+ return $self ;
+}
+
+
+sub find_exec_path {
+
+ my( $self ) = shift ;
+
+ my $proc_path = $self->{'path'} ;
+
+ return if -x $proc_path ;
+
+ foreach my $path ( File::Spec->path() ) {
+
+ my $exec_path = File::Spec->catfile( $path, $proc_path ) ;
+
+ next unless -f $exec_path ;
+
+ if ( -x $exec_path ) {
+
+ $self->{'path'} = $exec_path ;
+ return ;
+ }
+ }
+
+ return "$self->{'path'} is not found in $ENV{PATH}" ;
+}
+
+sub triggered_cell {
+
+ my( $self ) = @_ ;
+
+ my $err = $self->spawn() ;
+ return $err if $err ;
+
+#use Data::Dumper ;
+#print Dumper \%INC ;
+
+#print $self->status_cmd() ;
+
+ return ;
+}
+
+
+sub spawn {
+
+ my( $self ) = @_ ;
+
+ unless( $self->{'no_io'} ) {
+
+ $self->_parent_io() ;
+ }
+
+ $self->{'ppid'} = $$ ;
+
+ my @exec_args = @{$self->{'proc_args'}} ;
+
+ if ( my $pipe_args_ref = $self->cell_get_args( 'args' ) ) {
+
+ push( @exec_args, (ref $pipe_args_ref) ?
+ @{$pipe_args_ref} : $pipe_args_ref ) ;
+ }
+
+ my $pid = fork() ;
+ defined $pid or die "Stem::Proc can't fork $!" ;
+
+ if ( $pid ) {
+
+# in parent
+
+# must close the child fh in the parent so we will see a closed socket
+# when the child exits
+
+ unless( $self->{'no_io'} ) {
+
+ close $self->{'child_fh'} ;
+ close $self->{'child_err_fh'} if $self->{'use_stderr'} ;
+
+ delete( $self->{'child_fh'} ) ;
+ delete( $self->{'child_err_fh'} ) ;
+ }
+
+ TraceStatus "forked $pid" ;
+
+ $self->{'pid'} = $pid ;
+ $pid_to_obj{ $pid } = $self ;
+
+ $self->cell_set_args( 'info' => <<INFO ) ;
+
+Path: $self->{'path'}
+Args: @exec_args
+Pid: $pid
+
+INFO
+
+
+ }
+ else {
+
+# in child
+ unless( $self->{'no_io'} ) {
+
+ $self->_child_io() ;
+ }
+
+###############
+###############
+## add support for setting local(%ENV)
+###############
+###############
+
+#TraceStatus "Exec'ing $self->{'path'}, @exec_args" ;
+
+ exec $self->{'path'}, @exec_args ;
+
+ exit EXEC_ERROR ;
+ }
+
+# back in parent (unless no exec -- FIX THAT!! unless path is
+# required) we could do a forked stem hub by execing stem with a new
+# config which has a portal with STDIN/STDOUT as fh's
+
+ my $err = $self->cell_set_args( 'aio_args' => [
+ 'read_fh' => $self->{'parent_fh'},
+ 'write_fh' => $self->{'parent_fh'},
+ 'stderr_fh' => $self->{'parent_err_fh'},
+ 'closed_method' => $self->{'exited_method'},
+ ]
+ ) ;
+
+ return $err if $err ;
+
+ $self->cell_worker_ready() ;
+
+ return ;
+}
+
+
+sub _parent_io {
+
+ my( $self ) = @_ ;
+
+ my( $parent_fh, $child_fh ) ;
+
+
+ if ( $self->{'use_pty'} ) {
+
+ require IO::Pty ;
+ $parent_fh = IO::Pty->new() ;
+ $child_fh = $parent_fh->slave() ;
+ }
+ else {
+
+ $parent_fh = gensym ;
+ $child_fh = gensym ;
+
+ socketpair( $parent_fh, $child_fh,
+ AF_UNIX, SOCK_STREAM, PF_UNSPEC ) ||
+ die "can't make socket pair $!" ;
+ }
+
+ bless $parent_fh, 'IO::Socket' ;
+
+ $self->{'parent_fh'} = $parent_fh ;
+
+ $parent_fh->blocking( 0 ) ;
+
+ $self->{'child_fh'} = $child_fh ;
+
+#############
+# add pty support here
+#############
+
+ if ( $self->{'use_stderr'} ) {
+
+ my $parent_err_fh = gensym ;
+ my $child_err_fh = gensym ;
+
+ socketpair( $parent_err_fh, $child_err_fh,
+ AF_UNIX, SOCK_STREAM, PF_UNSPEC ) ||
+ die "can't make socket pair $!" ;
+
+ $self->{'parent_err_fh'} = $parent_err_fh ;
+ $self->{'child_err_fh'} = $child_err_fh ;
+ }
+}
+
+sub _child_io {
+
+ my( $self ) = @_ ;
+
+ close $self->{'parent_fh'} ;
+ close $self->{'parent_err_fh'} if $self->{'use_stderr'} ;
+
+ my $child_fd = fileno( $self->{'child_fh'} ) ;
+
+ open( \*STDIN, "<&$child_fd" ) ||
+ croak "dup open of STDIN failed $!" ;
+
+ open( \*STDOUT, ">&$child_fd" ) ||
+ croak "dup open of STDOUT failed $!" ;
+
+ if ( $self->{'use_stderr'} ) {
+
+ my $child_err_fd = fileno( $self->{'child_err_fh'} ) ;
+
+ open( \*STDERR, ">&$child_err_fd" ) ||
+ croak "dup open of STDERR failed $!" ;
+
+ }
+ else {
+ open( \*STDERR, ">&$child_fd" ) ||
+ croak "dup open of STDERR failed $!" ;
+ }
+}
+
+sub write {
+
+ my( $self, $data ) = @_ ;
+
+ $self->cell_write( $data ) ;
+}
+
+
+sub read_fh {
+
+ $_[0]->{'parent_fh'} ;
+}
+
+sub write_fh {
+
+ $_[0]->{'parent_fh'} ;
+}
+
+sub stderr_fh {
+
+ $_[0]->{'parent_err_fh'} ;
+}
+
+sub proc_ended {
+
+ my( $self ) = @_ ;
+
+#print "PROC ended, shutting down\n" ;
+
+ $self->shut_down() ;
+}
+
+sub signal_cmd {
+
+ my( $self, $msg ) = @_ ;
+
+ my $data = $msg->data() ;
+
+ return unless ref $data eq 'SCALAR' ;
+
+ my $signal = ${$data} ;
+
+ $self->signal( $signal ) ;
+
+ return ;
+}
+
+sub signal {
+
+ my( $self, $signal ) = @_ ;
+
+ $signal ||= 'SIGTERM' ;
+
+ TraceStatus "$self->{'pid'} received SIGTERM" ;
+
+ kill $signal, $self->{'pid'} ;
+}
+
+sub sig_chld_handler {
+
+ while ( 1 ) {
+
+ my $child_pid = waitpid( -1, WNOHANG ) ;
+
+ return if $child_pid == 0 || $child_pid == -1 ;
+
+ my $proc_status = $? ;
+
+ my ( $exit_code, $exit_signal ) ;
+
+ if ( WIFEXITED( $proc_status ) ) {
+
+ $exit_code = WEXITSTATUS( $proc_status ) ;
+
+ TraceStatus "EXIT: $exit_code" ;
+
+ }
+ else {
+ $exit_signal = WTERMSIG( $proc_status ) ;
+
+ TraceStatus "EXIT signal: $exit_signal" ;
+
+ }
+
+#print "EXIT CODE [$exit_code]\n" ;
+
+ if ( my $self = $pid_to_obj{ $child_pid } ) {
+
+ $self->{'exit_code'} = $exit_code ;
+ $self->{'exit_signal'} = $exit_signal ;
+
+ if ( defined( $exit_code ) &&
+ $exit_code == EXEC_ERROR ) {
+
+ print <<ERR ;
+Stem::Proc exec failed on path '$self->{'path'}'
+ERR
+
+ }
+
+ $self->exited() ;
+ }
+ else {
+#### ERROR
+print "reaped unknown process pid $child_pid\n"
+ }
+
+ }
+}
+
+sub exited {
+
+ my( $self ) = @_ ;
+
+######################
+# handle watchdog here
+######################
+
+ $self->{'exited'} = 1 ;
+
+#print "EXITED\n" ;
+
+ $self->shut_down() if $self->{'no_io'} ;
+
+ TraceStatus "Proc $self->{'pid'} exited" ;
+}
+
+
+sub shut_down {
+
+ my( $self ) = @_ ;
+
+#print "PROC SHUT\n" ;
+
+ unless( $self->{'exited'} ) {
+
+ kill 'SIGTERM', $self->{'pid'} ;
+
+ TraceStatus "kill of proc $self->{'pid'}" ;
+ }
+
+ return if $self->{'no_io'} ;
+
+ if ( my $pid = $self->{'pid'} ) {
+
+ delete( $pid_to_obj{ $pid } ) ;
+ }
+
+ $self->cell_shut_down() ;
+
+ close $self->{'parent_fh'} ;
+ close $self->{'parent_err_fh'} if $self->{'use_stderr'} ;
+}
+
+1 ;
--- /dev/null
+# File: Stem/Route.pm
+
+# This file is part of Stem.
+# Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
+
+# Stem is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# Stem is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with Stem; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# For a license to use the Stem under conditions other than those
+# described here, to purchase support for this software, or to purchase a
+# commercial warranty contract, please contact Stem Systems at:
+
+# Stem Systems, Inc. 781-643-7504
+# 79 Everett St. info@stemsystems.com
+# Arlington, MA 02474
+# USA
+
+package Stem::Route;
+
+#use Stem::Trace 'log' => 'stem_status', 'sub' => 'TraceStatus' ;
+#use Stem::Trace 'log' => 'stem_error' , 'sub' => 'TraceError' ;
+
+use strict ;
+
+use base 'Exporter' ;
+use vars qw( %EXPORT_TAGS ) ;
+
+%EXPORT_TAGS = (
+ 'cell' => [ qw(
+ register_cell
+ alias_cell
+ unregister_cell
+ lookup_cell
+ lookup_cell_name
+ register_class
+ ) ],
+ 'filter' => [ qw(
+ push_filter_on_cell
+ pop_filter_from_cell
+ ) ],
+) ;
+
+Exporter::export_ok_tags( qw( cell filter ) );
+
+use constant DEBUG => 1;
+
+my %cell_info ;
+my %cell_name_to_obj ;
+
+register_class( __PACKAGE__, 'reg' ) ;
+
+#use diagnostics -verbose;
+
+## registration takes a minimum args of an object and a name.
+## an optional third arg of target is also accepted.
+##
+## the idea here is that when a portal connects, it's registered
+## with the local hub - which makes everyone aware of the new
+## portal.
+##
+## a couple remaining questions though .. should this registration
+## include the capabilities of the new portal? should we add
+## an 'authentication' capability to the registration process?
+## ...just a few thoughts
+
+
+sub register_cell {
+
+ my( $obj, $name, $target ) = @_ ;
+
+ unless( $obj && $name ) {
+
+ my $err = <<ERR ;
+register() requires an object and a name, with an optional target.
+ERR
+
+# TraceError $err ;
+
+ return $err ;
+ }
+
+ $target = '' unless defined $target ;
+
+ if ( $cell_name_to_obj{ $name }{ $target } ) {
+
+ my $err =
+ "register_Cell $name:$target is already registered\n" ;
+
+ return $err ;
+ }
+
+ $cell_name_to_obj{ $name }{ $target } = $obj ;
+
+ $cell_info{ $obj }{'names'}{ $name }{ $target } = 1 ;
+ $cell_info{ $obj }{'primary_name'} ||= [ $name, $target ] ;
+
+ return ;
+}
+
+sub register_class {
+
+ my( $class, @nicks ) = @_ ;
+
+ foreach my $name ( $class, @nicks ) {
+
+ register_cell( $class, $name ) ;
+ }
+}
+
+sub alias_cell {
+
+ my( $obj, $name, $target ) = @_ ;
+
+ unless( $obj && $name ) {
+
+ my $err = <<ERR ;
+alias_cell() requires an object and a name, with an optional target.
+ERR
+
+# TraceError $err ;
+
+ return $err ;
+ }
+
+ $target = '' unless defined $target ;
+
+
+ unless ( lookup_cell( $name, $target ) ) {
+
+ my $err = "Alias_cell: $name:$target is not registered\n" ;
+
+# TraceError $err ;
+
+ return $err ;
+ }
+
+ $cell_name_to_obj{ $name }{ $target } = $obj ;
+ $cell_info{ $obj }{'names'}{ $name }{ $target } = 1 ;
+
+
+ return ;
+}
+
+sub unregister_cell {
+
+ my( $obj ) = shift ;
+
+ my $info_ref = $cell_info{ $obj } ;
+
+ unless ( $info_ref ) {
+
+ my $err = "unregister_cell: object [$obj] is not registered" ;
+ return $err ;
+ }
+
+ foreach my $name ( keys %{ $info_ref->{'names'} } ) {
+
+ foreach my $target (
+ keys %{ $info_ref->{'names'}{$name} } ) {
+
+ delete $cell_name_to_obj{ $name }{ $target } ;
+ delete $cell_name_to_obj{ $name } if $target eq '' ;
+ }
+ }
+
+ delete $cell_info{ $obj } ;
+
+ return ;
+}
+
+
+# this sub returns a cell if it is registered. otherwise it returns a
+# proper false
+#
+# first check that the cell or parent cell exists.
+# if it is a targeted address then find the targeted cell or its parent cell
+# otherwise look for the regular cell with a null target.
+
+sub lookup_cell {
+
+ my( $name, $target ) = @_ ;
+
+#print "LOOK N [$name] T [$target]\n" ;
+ return unless exists( $cell_name_to_obj{ $name } ) ;
+
+# look for a targeted cell first and then for a configured or class cell
+
+ if ( defined $target ) {
+
+ my $obj = $cell_name_to_obj{ $name }{ $target } ;
+ return $obj if $obj ;
+ }
+
+ return $cell_name_to_obj{ $name }{''} ;
+}
+
+
+sub lookup_cell_name {
+
+ my( $obj ) = @_ ;
+
+ my $names_ref = $cell_info{ $obj }{'primary_name'} ;
+
+ return ( @{$names_ref} ) if $names_ref ;
+
+ return ;
+}
+
+
+sub push_filter_on_cell {
+
+ my( $obj, $filter ) = @_ ;
+
+ unless ( exists( $cell_info{ $obj } ) ) {
+
+ my $err = "push_filter_on_cell: object [$obj] is not registered" ;
+ return $err ;
+ }
+
+ push( @{ $cell_info{ $obj }{'filters'} }, $filter ) ;
+
+ return ;
+}
+
+sub pop_filter_on_cell {
+
+ my( $obj ) = @_ ;
+
+ unless ( exists( $cell_info{ $obj } ) ) {
+
+ my $err = "pop_filter_on_cell: object [$obj] is not registered" ;
+ return $err ;
+ }
+
+ pop( @{ $cell_info{ $obj }{'filters'} } ) ;
+
+ return ;
+}
+
+sub get_cell_filters {
+
+ my( $obj ) = @_ ;
+
+ return ( wantarray ) ? @{ $cell_info{ $obj }{'filters'} } :
+ $cell_info{ $obj }{'filters'} ;
+}
+
+
+sub status_cmd {
+
+ my( $class, $msg ) = @_ ;
+
+ my ( @cell_lines, %class_cell_texts ) ;
+
+#print map "$_ => $cell_name_to_obj{$_}\n", keys %cell_name_to_obj ;
+
+ foreach my $name ( keys %cell_name_to_obj ) {
+
+ my $cell = $cell_name_to_obj{$name}{''} ;
+
+#print "CELL $cell\n" ;
+
+# see if this is a Class Cell name
+
+ unless ( ref $cell ) {
+
+ my $pad = "\t" x ( 3 - int( length( $cell ) / 8 ) ) ;
+
+ $class_cell_texts{$cell} ||= "\t$cell$pad=>" ;
+
+ next if $name eq $cell ;
+
+# it is a Class Cell alias
+ $class_cell_texts{$cell} .= " $name" ;
+ next ;
+ }
+
+ my $pad = "\t" x ( 4 - int( length( $name ) / 8 ) ) ;
+
+ my $cell_text = "\t$name$pad=> $cell\n" ;
+
+ foreach my $target ( keys %{ $cell_name_to_obj{$name} } ) {
+
+ next if $target eq '' ;
+
+ my $cell = $cell_name_to_obj{$name}{$target} ;
+
+ my $pad = "\t" x (3 - int( length( ":$target" ) / 8 )) ;
+
+ $cell_text .= "\t\t:$target$pad=> $cell\n" ;
+ }
+
+ push @cell_lines, $cell_text ;
+ }
+
+ @cell_lines = sort @cell_lines ;
+ my @class_lines = map { "$_\n" } sort values %class_cell_texts ;
+
+ my $hub_name = $Stem::Vars::Hub_name || '' ;
+
+ return <<STATUS ;
+
+Route Status for Hub '$hub_name'
+
+ Object Cells with Target names of their Cloned Cells
+
+@cell_lines
+ Class Cells with their Aliases
+
+@class_lines
+
+STATUS
+
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Stem::Route - Manages the Message Routing Tables and Cell Registry
+
+=head1 SYNPOSIS
+
+ use Stem::Route qw( :all );
+
+# $target is optional
+ register_cell( $object, $name, $target ) ;
+ unregister_cell($object);
+# or alternately...
+# again $target is optional
+ unregister_by_name($name, $target);
+
+=head1 DESCRIPTION
+
+The Stem::Route class manages the registry of Stem Cells and their
+names for a given Stem Hub (process). Any object which has selected
+methods which take Stem::Msg objects as arguments can be a registered
+cell. There are only 4 class methods in this module which work with
+the cell registry. They can be exported into a module individually or
+you can use the export tag :all to get them all.
+
+ register_cell( $object, $name )
+ register_cell( $object, $name, $target )
+
+ This class method takes the object to be registered and its
+ cell name and an optional target name. The object is
+ registered as the cell in this hub with this name/target
+ address. The cell address must be free to use - if it is in
+ used an error string is logged and returned. This address will be the
+ primary one for this cell. undef or () is returned upon
+ success.
+
+ alias_cell( $object, $alias )
+ alias_cell( $object, $alias, $target )
+
+ This class method takes the object and a cell alias for it and
+ an optional target name. The object will be registered as the
+ cell in this hub with this alias/target address. The object
+ must already be registered cell or an error string is logged
+ and returned. undef or () is returned upon a success.
+
+ lookup_cell( $name, $target )
+
+ This class method takes a cell name and an optional target and
+ it looks up the cell registered under that address pair. It
+ returns the object if found or undef or () upon failure.
+
+ unregister_cell( $object )
+
+ This class method takes a object and deletes it and all of its
+ names and aliases from the cell registry. If the object is not
+ registered an error string is logged and returned.
+
+=head1 AUTHOR
+
+Originally started by Uri, current breakout by a-mused.
+
+=head1 STATUS
+
+Actively being developed.
+
+=head1 LAST-CHANGE
+
+Mon Jan 22 14:15:52 EST 2001
+
+=head1 NOTES
+
+ newest at the bottom
+
+ 23 Jan 01
+ [01:09:34] <uri> here is a registry issue: i want to interpose cell in a
+ message stream. how do i do that without redoing all the configs?
+ [01:09:50] <uri> sorta like invisible renaming on the fly
+ [01:09:56] <amused> hrmm
+ [01:10:11] <uri> think about it. that will be big one day
+ [01:11:01] <uri> just like sysv streams. we push stuff onto the registry address. then messages get sent down
+ the list of pushed cells before being delivered to the real destination.
+ [01:11:29] <uri> so we need a way of moving messages from cell to cell without registering them globally but in
+ some sort of pipeline
+ [01:13:39] <amused> doesn't that violate a whole bunch of models and break distributed (multi-target) stuff?
+ [01:13:45] <uri> so instead of deliver, they RETURN a message. like status_cmd returns a status string
+ [01:14:12] <uri> no, only certain cells do that and only when they get
+ messages delivered that way.
+ [01:14:31] <uri> like stream_msg_in is called and it will return a message.
+ [01:14:44] <uri> insteead of msg_in or status_cmd.
+ [01:14:51] <amused> gotcha
+ [01:14:58] <uri> special input/output.
+ [01:15:00] <uri> same cell
+ [01:16:18] <uri> i like that. A LOT! very easy to do cell wise. and not much
+ work on the delivery side. some way to make the registry store a
+ stack of these under the name. make it a simple structure instead
+ of a cell you find with lookup.
+ [13:14:51] <uri> you push filter cells onto the destination cell (indexed by
+ its object ref). then any alias to it will have the same stack of
+ filters.
+ [13:15:52] <uri> when we deliver a message (the stuf you are touching), we
+ lookup the cell and then lookup via its ref) any filters. we then
+ loop over the filters passing in the message and getting one in
+ return and passint it to the next filter.
+ [13:16:02] <uri> just like sysV streams but unidirectional.
+ [13:16:38] <uri> we can interpose ANY set of filters before any named cell
+ transparently
+ [13:16:39] <uri> this is VERY cool.
+ [13:16:53] <uri> but not critical now. i just want to write up some notes on
+ it.
+
+=cut
+
--- /dev/null
+# File: Stem/SockMsg.pm
+
+# This file is part of Stem.
+# Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
+
+# Stem is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# Stem is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with Stem; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# For a license to use the Stem under conditions other than those
+# described here, to purchase support for this software, or to purchase a
+# commercial warranty contract, please contact Stem Systems at:
+
+# Stem Systems, Inc. 781-643-7504
+# 79 Everett St. info@stemsystems.com
+# Arlington, MA 02474
+# USA
+
+package Stem::SockMsg ;
+
+use strict ;
+
+use Data::Dumper ;
+
+use Stem::Socket ;
+use Stem::Trace 'log' => 'stem_status', 'sub' => 'TraceStatus' ;
+use Stem::Trace 'log' => 'stem_error' , 'sub' => 'TraceError' ;
+use Stem::Route qw( :cell ) ;
+use base 'Stem::Cell' ;
+
+use Stem::Debug qw( dump_data dump_socket ) ;
+
+
+my $attr_spec = [
+
+ {
+ 'name' => 'reg_name',
+ 'help' => <<HELP,
+The registration name for this Cell
+HELP
+ },
+
+ {
+ 'name' => 'host',
+ 'env' => 'host',
+ 'help' => <<HELP,
+Host address to listen on or connect to
+HELP
+ },
+
+ {
+ 'name' => 'port',
+ 'env' => 'port',
+ 'required' => 1,
+ 'help' => <<HELP,
+Port address to listen on or connect to
+HELP
+ },
+
+ {
+ 'name' => 'server',
+ 'type' => 'boolean',
+ 'help' => <<HELP,
+Mark this Cell as a server (listens for connections)
+HELP
+ },
+
+ {
+ 'name' => 'connect_now',
+ 'type' => 'boolean',
+ 'help' => <<HELP,
+Connect upon Cell creation
+HELP
+ },
+
+ {
+ 'name' => 'status_addr',
+ 'type' => 'address',
+ 'help' => <<HELP,
+Send status (connect/disconnect) messages to this address.
+HELP
+ },
+
+ {
+ 'name' => 'sync',
+ 'type' => 'boolean',
+ 'default' => 0,
+ 'help' => <<HELP,
+Mark this as a synchronously connecting socket. Default is asyncronous
+connections. In both cases the same method callbacks are used.
+HELP
+ },
+
+ {
+ 'name' => 'log_name',
+ 'help' => <<HELP,
+Log to send connection status to
+HELP
+ },
+
+ {
+ 'name' => 'cell_attr',
+ 'class' => 'Stem::Cell',
+ 'help' => <<HELP,
+Argument list passed to Stem::Cell for this Cell
+HELP
+ },
+
+] ;
+
+#my $listener ;
+
+
+sub new {
+
+ my( $class ) = shift ;
+
+ my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
+ return $self unless ref $self ;
+
+ if ( $self->{'server'} ) {
+ my $listen_obj = Stem::Socket->new(
+ 'object' => $self,
+ 'host' => $self->{'host'},
+ 'port' => $self->{'port'},
+ 'server' => 1,
+ ) ;
+
+ return $listen_obj unless ref $listen_obj ;
+
+ my $host_text = $self->{'host'} ;
+
+ $host_text = 'localhost' unless defined $host_text ;
+
+ my $info = <<INFO ;
+SockMsg
+Type: server
+Local: $host_text:$self->{'port'}
+INFO
+
+ $self->cell_info( $info ) ;
+
+ $self->{'listen_obj'} = $listen_obj ;
+
+#print "LISTEN $listen_obj\n" ;
+#$listener = $listen_obj ;
+
+ $self->cell_activate() ;
+ }
+ elsif ( $self->{'connect_now'} ) {
+
+ $self->connect() ;
+ }
+
+ $self->cell_set_args(
+ 'host' => $self->{'host'},
+ 'port' => $self->{'port'},
+ 'server' => $self->{'server'},
+ ) ;
+
+#print "Sock\n", Dumper( $self ) ;
+
+ return( $self ) ;
+}
+
+sub connect {
+
+ my( $self ) = @_ ;
+
+#print "MODE [$self->{connecting}]\n" ;
+
+# return if $self->{connecting}++ ;
+
+ my $host = $self->cell_get_args( 'host' ) || $self->{'host'} ;
+ my $port = $self->cell_get_args( 'port' ) || $self->{'port'} ;
+ my $sync = $self->cell_get_args( 'sync' ) || $self->{'sync'} ;
+
+########################
+########################
+## handle connect timeouts
+########################
+########################
+
+#TraceStatus "Connecting to $host:$port" ;
+
+ my $sock_obj = Stem::Socket->new(
+ 'object' => $self,
+ 'host' => $host,
+ 'port' => $port,
+ 'sync' => $sync,
+ ) ;
+
+ return $sock_obj unless ref $sock_obj ;
+
+ $self->{'sock_obj'} = $sock_obj ;
+
+ return ;
+}
+
+sub connected {
+
+ my( $self, $connected_sock ) = @_ ;
+
+#print "CONNECTED\n" ;
+
+ $self->{connected} = 1 ;
+
+ $self->send_status_msg( 'connected' ) ;
+
+ my $type = $self->{'sock_obj'} ?
+ $self->{'sock_obj'}->type() :
+ 'sync connected' ;
+
+ my $info = sprintf( <<INFO,
+SockMsg connected
+Type: $type
+Local: %s:%d
+Remote: %s:%d
+INFO
+ $connected_sock->sockhost(),
+ $connected_sock->sockport(),
+ $connected_sock->peerhost(),
+ $connected_sock->peerport(),
+ ) ;
+
+ TraceStatus "\n$info" ;
+
+ if ( my $log_name = $self->{ 'log_name' } ) {
+
+#print "MSG LOG\n" ;
+
+ Stem::Log::Entry->new(
+ 'logs' => $log_name,
+ 'text' => "Connected\n$info",
+ ) ;
+ }
+
+ $self->cell_set_args(
+ 'fh' => $connected_sock,
+ 'aio_args' =>
+ [ 'fh' => $connected_sock ],
+ 'info' => $info,
+ ) ;
+
+ my $err = $self->cell_trigger() ;
+# print "TRIGGER ERR [$err]\n" unless ref $err ;
+}
+
+# this method is called after the cell is triggered. this cell can be
+# the original cell or a cloned one.
+
+sub triggered_cell {
+
+ my( $self ) = @_ ;
+
+#print "SockMsg triggered\n" ;
+ return if $self->{'server'} ;
+
+# return "SockMsg: can't connect a server socket" if $self->{'server'} ;
+
+ return $self->connect() ;
+}
+
+# we handle the socket close method directly here so we can reconnect
+# if needed. the other async method callbacks are in Cell.pm
+
+sub async_closed {
+
+ my( $self ) = @_ ;
+
+# reconnect stuff. should be in Socket.pm
+
+# my $sock = $self->cell_get_args( 'fh' ) ;
+# $sock->close() ;
+#print "Sock MSG: closed name $self->{'reg_name'}\n" ;
+# $self->{'sock_obj'}->connect_to() ;
+
+ $self->send_status_msg( 'disconnected' ) ;
+
+ if ( my $log_name = $self->{ 'log_name' } ) {
+
+ Stem::Log::Entry->new(
+ 'logs' => $log_name,
+ 'text' => "Closed\n$self->{'info'}",
+ )
+ }
+
+# TraceStatus "Disconnected" ;
+
+ $self->cell_set_args( 'info' => 'SockMsg disconnected' ) ;
+
+######################
+######################
+# add support for reconnect.
+# it has a flag, delay, retry count.
+######################
+######################
+
+ $self->shut_down() ;
+}
+
+sub shut_down {
+
+ my( $self ) = @_ ;
+
+#print "SOCKMSG SHUT $self\n", caller(), "\n", dump_data $self ;
+
+ $self->cell_shut_down() ;
+
+ unless ( $self->{'connected'} ) {
+
+use Carp 'cluck' ;
+#cluck "SOCKMSG SHUT SERVER $self\n" ;
+
+ my $sock_obj = $self->{'sock_obj'} ;
+
+ $sock_obj->shut_down() ;
+ }
+}
+
+sub send_status_msg {
+
+ my( $self, $status ) = @_ ;
+
+ my $status_addr = $self->{status_addr} or return ;
+
+ my $status_msg = Stem::Msg->new(
+ to => $status_addr,
+ from => $self->cell_from_addr(),
+ type => 'status',
+ data => {
+ status => $status,
+ },
+ ) ;
+
+ $status_msg->dispatch() ;
+}
+
+
+
+sub DESTROY {
+ my ( $self ) = @_ ;
+
+# print "SOCKMSG DESTROY", caller(), "\n" ;
+
+#print $self->_dump( "DESTROY") ;
+}
+
+
+# sub IO::Socket::INET::DESTROY {
+# my ( $self ) = @_ ;
+
+# # print "IO::DESTROY\n", dump_socket( $self ) ;
+
+# #warn "L $listener - S $self\n" if $listener == $self ;
+
+# # print "SOCKMSG DESTROY", caller(), "\n" ;
+# #cluck "IO::DESTROY $self\n" ;
+# }
+
+1 ;
--- /dev/null
+# File: Stem/Socket.pm
+
+# This file is part of Stem.
+# Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
+
+# Stem is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# Stem is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with Stem; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# For a license to use the Stem under conditions other than those
+# described here, to purchase support for this software, or to purchase a
+# commercial warranty contract, please contact Stem Systems at:
+
+# Stem Systems, Inc. 781-643-7504
+# 79 Everett St. info@stemsystems.com
+# Arlington, MA 02474
+# USA
+
+#######################################################
+
+#print "LOADED\n" ;
+
+package Stem::Socket ;
+
+use strict ;
+
+use IO::Socket ;
+use Symbol ;
+use Errno qw( EINPROGRESS ) ;
+
+use Stem::Class ;
+
+my $attr_spec = [
+
+ {
+ 'name' => 'object',
+ 'required' => 1,
+ 'type' => 'object',
+ 'help' => <<HELP,
+This is the owner object which has the methods that get called when Stem::Socket
+has either connected, timed out or accepted a socket connection
+HELP
+ },
+ {
+ 'name' => 'server',
+ 'type' => 'boolean',
+ 'help' => <<HELP,
+If set, then this is a server socket.
+HELP
+ },
+ {
+ 'name' => 'sync',
+ 'type' => 'boolean',
+ 'default' => 0,
+ 'help' => <<HELP,
+Mark this as a synchronously connecting socket. Default is asyncronous
+connections. In both cases the same method callbacks are used.
+HELP
+ },
+ {
+ 'name' => 'port',
+ 'required' => 1,
+ 'help' => <<HELP,
+This is the TCP port number for listening or connecting.
+HELP
+ },
+ {
+ 'name' => 'host',
+ 'default' => 'localhost',
+ 'help' => <<HELP,
+Host to connect to or listen on. If a listen socket host is explicitly
+set to '', then the host will be INADDR_ANY which allows a server to
+listen on all host interfaces.
+HELP
+ },
+ {
+ 'name' => 'method',
+ 'default' => 'connected',
+ 'help' => <<HELP,
+This method is called in the owner object when when a socket
+connection or accept happens.
+HELP
+ },
+ {
+ 'name' => 'timeout_method',
+ 'default' => 'connect_timeout',
+ 'help' => <<HELP,
+This method is called in the owner object when when a socket
+connection times out.
+HELP
+ },
+ {
+ 'name' => 'timeout',
+ 'default' => 10,
+ 'help' => <<HELP,
+How long to wait (in seconds) before a connection times out.
+HELP
+ },
+ {
+ 'name' => 'max_retries',
+ 'default' => 0,
+ 'help' => <<HELP,
+The maximum number of connection retries before an error is returned.
+HELP
+ },
+ {
+ 'name' => 'listen',
+ 'default' => '5',
+ 'help' => <<HELP,
+This sets how many socket connections can be queued by a server socket.
+HELP
+ },
+ {
+ 'name' => 'ssl_args',
+ 'type' => 'list',
+ 'help' => <<HELP,
+This makes the socket use the IO::Socket::SSL module for secure sockets. The
+arguments are passed to the new() method of that module.
+HELP
+ },
+ {
+ 'name' => 'id',
+ 'help' => <<HELP,
+The id is passed to the callback method as its only argument. Use it to
+identify different instances of this object.
+HELP
+
+ },
+] ;
+
+sub new {
+
+ my( $class ) = shift ;
+
+ my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
+ return $self unless ref $self ;
+
+ if ( $self->{ 'server' } ) {
+
+ $self->{'type'} = 'server' ;
+ my $listen_err = $self->listen_to() ;
+
+#print "ERR [$listen_err]\n" ;
+ return $listen_err if $listen_err ;
+ }
+ else {
+
+ $self->{'type'} = 'client' ;
+ my $connect_err = $self->connect_to() ;
+ return $connect_err if $connect_err ;
+ }
+
+ return( $self ) ;
+}
+
+use Carp 'cluck' ;
+
+sub shut_down {
+
+ my( $self ) = @_ ;
+
+#cluck "SOCKET SHUT" ;
+
+ if ( $self->{'type'} eq 'server' ) {
+
+#print "SOCKET SHUT server" ;
+
+ if ( my $read_event = delete $self->{'read_event'} ) {
+
+ $read_event->cancel() ;
+ }
+
+ my $listen_sock = delete $self->{'listen_sock'} ;
+ $listen_sock->close() ;
+
+ return ;
+ }
+
+#print "SOCKET SHUT client" ;
+
+ $self->_write_cancel() ;
+
+ return ;
+}
+
+sub type {
+ $_[0]->{'type'} ;
+}
+
+sub connect_to {
+
+ my( $self ) = @_ ;
+
+ my $connect_sock = Stem::Socket::get_connected_sock(
+ $self->{'host'},
+ $self->{'port'},
+ $self->{'sync'},
+ ) ;
+
+ return $connect_sock unless ref $connect_sock ;
+
+ $self->{'connected_sock'} = $connect_sock ;
+
+ if( $self->{'sync'} ) {
+
+ $self->connect_writeable() ;
+ return ;
+ }
+
+# create and save the write event watcher
+
+ my $write_event = Stem::Event::Write->new(
+ 'object' => $self,
+ 'fh' => $connect_sock,
+ 'timeout' => $self->{'timeout'},
+ 'method' => 'connect_writeable',
+ 'timeout_method' => 'connect_timeout',
+ ) ;
+
+ return $write_event unless ref $write_event ;
+ $self->{'write_event'} = $write_event ;
+ $write_event->start() ;
+
+ return ;
+}
+
+# callback when a socket is connected (the socket is writeable)
+
+sub connect_writeable {
+
+ my( $self ) = @_ ;
+
+# get the connected socket
+
+ my $connected_sock = $self->{'connected_sock'} ;
+
+ if ( my $ssl_args = $self->{'ssl_args'} ) {
+
+ require IO::Socket::SSL ;
+ IO::Socket::SSL->VERSION(0.96);
+
+ my $err = IO::Socket::SSL->start_SSL(
+ $connected_sock,
+ @{$ssl_args}
+ ) ;
+
+ $err || die
+ "bad ssl connect socket: " . IO::Socket::SSL::errstr() ;
+ }
+
+# the i/o for sockets is always non-blocking in stem.
+
+ $connected_sock->blocking( 0 ) ;
+
+# callback the owner object with the connected socket as the argument
+
+ my $method = $self->{'method'} ;
+ $self->{'object'}->$method( $connected_sock, $self->{'id'} );
+
+ $self->_write_cancel() ;
+
+ return ;
+}
+
+sub connect_timeout {
+
+ my( $self ) = @_ ;
+
+ $self->_write_cancel() ;
+
+ $self->{'connected_sock'}->close() ;
+ delete $self->{'connected_sock'} ;
+
+ if ( $self->{'max_retries'} && --$self->{'retry_count'} > 0 ) {
+
+ my $method = $self->{'timeout_method'} ;
+ $self->{'object'}->$method( $self->{'id'} );
+ return ;
+ }
+
+ $self->connect_to() ;
+
+ return ;
+}
+
+sub _write_cancel {
+
+ my( $self ) = @_ ;
+
+# my $sock = delete $self->{'connected_sock'} ;
+# $sock->close() ;
+
+ my $event = delete $self->{'write_event'} ;
+ return unless $event ;
+ $event->cancel() ;
+}
+
+sub get_connected_sock {
+
+ my( $host, $port, $sync ) = @_ ;
+
+ unless( $port ) {
+
+ my $err = "get_connected_sock Missing port" ;
+ return $err ;
+ }
+
+# get the host name or IP and convert it to an inet address
+
+ my $inet_addr = inet_aton( $host ) ;
+
+ unless( $inet_addr ) {
+
+ my $err = "get_connected_sock Unknown host [$host]" ;
+ return $err ;
+ }
+
+# check if it is a get the service name or numeric port and convert it
+# to a port number
+
+ if ( $port =~ /\D/ and not $port = getservbyname( $port, 'tcp' ) ) {
+
+ my $err = "get_connected_sock: unknown port [$port]" ;
+ return $err ;
+ }
+
+# prepare the socket address
+
+ my $sock_addr = pack_sockaddr_in( $port, $inet_addr ) ;
+
+ my $connect_sock = IO::Socket::INET->new( Domain => AF_INET) ;
+
+#print "connect $connect_sock [", $connect_sock->fileno(), "]\n" ;
+
+# set the sync (connect blocking) mode
+
+ $connect_sock->blocking( $sync ) ;
+
+ unless ( connect( $connect_sock, $sock_addr ) ) {
+
+# handle linux false error of EINPROGRESS
+
+ return <<ERR unless $! == EINPROGRESS ;
+get_connected_sock: connect to '$host:$port' error $!
+ERR
+ }
+
+ return $connect_sock ;
+}
+
+sub listen_to {
+
+ my( $self ) = @_ ;
+
+ my $listen_sock = get_listen_sock(
+ $self->{'host'},
+ $self->{'port'},
+ $self->{'listen'},
+ ) ;
+
+ return $listen_sock unless ref $listen_sock ;
+
+ $self->{'listen_sock'} = $listen_sock ;
+
+# create and save the read event watcher
+
+ my $read_event = Stem::Event::Read->new(
+ 'object' => $self,
+ 'fh' => $listen_sock,
+ 'method' => 'listen_readable',
+ ) ;
+
+ $self->{'read_event'} = $read_event ;
+
+ return ;
+}
+
+# callback when a socket can be accepted (the listen socket is readable)
+
+sub listen_readable {
+
+ my( $self ) = @_ ;
+
+# get the accepted socket
+
+ my $accepted_sock = $self->{'listen_sock'}->accept() ;
+
+# $accepted_sock || die "bad accept socket: ";
+my $fileno = fileno $accepted_sock ;
+#print "ACCEPT [$accepted_sock] ($fileno)\n" ;
+
+ if ( my $ssl_args = $self->{'ssl_args'} ) {
+
+ require IO::Socket::SSL ;
+ IO::Socket::SSL->VERSION(0.96);
+
+ my $err = IO::Socket::SSL->start_SSL(
+ $accepted_sock,
+ SSL_server => 1,
+ @{$ssl_args}
+ ) ;
+
+ $err || die
+ "bad ssl accept socket: " . IO::Socket::SSL::errstr() ;
+ }
+
+# the i/o for sockets is always non-blocking in stem.
+
+ $accepted_sock->blocking( 0 ) ;
+
+# callback the object/method with the accepted socket as the argument
+
+ my $method = $self->{'method'} ;
+ $self->{'object'}->$method( $accepted_sock, $self->{'id'} );
+ return ;
+}
+
+sub stop_listening {
+
+ my( $self ) = @_ ;
+
+ my $read_event = $self->{'read_event'} ;
+ return unless $read_event ;
+ $read_event->stop() ;
+}
+
+sub start_listening {
+
+ my( $self ) = @_ ;
+
+ my $read_event = $self->{'read_event'} ;
+ return unless $read_event ;
+ $read_event->start() ;
+}
+
+sub get_listen_sock {
+
+ my( $host, $port, $listen ) = @_ ;
+
+ return "get_listen_sock Missing port" unless $port ;
+
+# get the host name or IP and convert it to an inet address
+# an empty host ('') will force INADDR_ANY
+
+ my $inet_addr = length( $host ) ? inet_aton( $host ) : INADDR_ANY ;
+
+#print "HOST [$host]\n" ;
+#print inet_ntoa( $inet_addr ), "\n" ;
+
+ return "get_listen_sock Unknown host [$host]" unless $inet_addr ;
+
+# check if it is a get the service name or numeric port and convert it
+# to a port number
+
+ if ( $port =~ /\D/ and not $port = getservbyname( $port, 'tcp' ) ) {
+
+ return "get_listen_sock: unknown port [$port]" ;
+ }
+
+# prepare the socket address
+
+ my $sock_addr = pack_sockaddr_in( $port, $inet_addr ) ;
+
+ my $listen_sock = IO::Socket::INET->new(
+
+ Proto => 'tcp',
+ LocalAddr => $host,
+ LocalPort => $port,
+ Listen => $listen,
+ Reuse => 1,
+ ) ;
+
+ return( "get_listen_sock: $host:$port $!" ) unless $listen_sock ;
+ return $listen_sock ;
+}
+
+1 ;
--- /dev/null
+# File: Stem/Switch.pm
+
+# This file is part of Stem.
+# Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
+
+# Stem is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# Stem is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with Stem; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# For a license to use the Stem under conditions other than those
+# described here, to purchase support for this software, or to purchase a
+# commercial warranty contract, please contact Stem Systems at:
+
+# Stem Systems, Inc. 781-643-7504
+# 79 Everett St. info@stemsystems.com
+# Arlington, MA 02474
+# USA
+
+package Stem::Switch ;
+
+use Stem::Trace 'log' => 'stem_status', 'sub' => 'TraceStatus' ;
+use Stem::Trace 'log' => 'stem_error' , 'sub' => 'TraceError' ;
+
+use strict ;
+
+=head1 Stem::switch
+
+Stem::Switch has several functions:
+
+ new
+ msg_in
+ data_in
+ map_cmd
+ info_cmd
+ status_cmd
+
+=cut
+
+my $this_package = __PACKAGE__ ;
+
+my $attr_spec = [
+
+ {
+ 'name' => 'reg_name',
+ 'required' => 1,
+ 'help' => <<HELP,
+Required field.
+This is a unique name used to register this instance of a Switch.
+HELP
+ },
+
+ {
+ 'name' => 'in_map',
+ 'default' => {},
+ 'type' => 'HoL',
+ 'help' => <<HELP,
+This field contains the incoming address map.
+Any message coming in to one of these addresses will be resent out
+to every address in out_map.
+HELP
+ },
+
+ {
+ 'name' => 'out_map',
+ 'default' => {},
+ 'type' => 'HoL',
+ 'help' => <<HELP,
+This contains the outgoing addresses for this Switch.
+HELP
+ },
+] ;
+
+=head2 new
+
+new creates a new Stem::Switch object, parsing $attr_spec and any arguments
+passed to it.
+
+It returns the new object.
+
+=cut
+
+sub new {
+
+ my( $class ) = shift ;
+
+ my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
+ return $self unless ref $self ;
+
+##########
+# to be replaced with Stem::Class supporting 'hash' attribute types
+##########
+
+ if ( ref $self->{'in_map'} eq 'ARRAY' ) {
+
+ $self->{'in_map'} = { @{$self->{'in_map'}} } ;
+ }
+
+ if ( ref $self->{'out_map'} eq 'ARRAY' ) {
+
+ $self->{'out_map'} = { @{$self->{'out_map'}} } ;
+ }
+
+ return( $self ) ;
+}
+
+use Data::Dumper ;
+
+
+sub msg_in {
+
+ my( $self, $msg ) = @_ ;
+
+ my $in_target = $msg->to_target() ;
+
+ my $in_map = $self->{'in_map'}{$in_target} ;
+
+ return unless $in_map ;
+
+ my @out_keys = ref $in_map ? @{$in_map} : ($in_map) ;
+
+# loop over all the output keys for this in_map entry
+
+ foreach my $out_key ( @out_keys ) {
+
+ my $out_addr = $self->{'out_map'}{$out_key} ;
+
+ next unless $out_addr ;
+
+ my @out_addrs = ref $out_addr ? @{$out_addr} : ($out_addr) ;
+
+# loop over all the output address for this out_map entry
+
+ foreach my $out_addr ( @out_addrs ) {
+
+# now we clone the message with the new address
+
+ my $switched_msg = $msg->clone(
+
+ 'to' => $out_addr,
+ ) ;
+
+ $switched_msg->dispatch() ;
+ }
+ }
+}
+
+
+sub map_cmd {
+
+ my( $self, $msg ) = @_ ;
+
+ my @tokens = split( ' ', ${$msg->data()} ) ;
+
+ my $target = shift @tokens ;
+
+ $self->{'in_map'}{$target} = \@tokens ;
+
+ return ;
+}
+
+sub out_map_cmd {
+
+ my( $self, $msg ) = @_ ;
+
+ my @tokens = split( ' ', ${$msg->data()} ) ;
+
+ my $key = shift @tokens ;
+
+ $self->{'out_map'}{$key} = \@tokens ;
+
+ return ;
+}
+
+
+sub info_cmd {
+
+ my( $self, $msg ) = @_ ;
+
+ return <<INFO ;
+
+Info Response
+Class: $this_package
+Ref: $self
+
+This cell is a message multiplex or switch. Any message addressed to a
+target in the cell, can be resent to any subset of the output map
+addresses.
+
+INFO
+
+}
+
+
+sub status_cmd {
+
+ my( $self, $msg ) = @_ ;
+
+ my( $status_text ) ;
+
+ $status_text = <<TEXT ;
+
+Status of switch: $self->{'reg_name'}
+
+In Map:
+
+TEXT
+
+ foreach my $target ( sort keys %{$self->{'in_map'}} ) {
+
+ my $targets_ref = $self->{'in_map'}{$target} ;
+ my @targets = ref $targets_ref ?
+ @{$targets_ref} : ($targets_ref) ;
+
+ $status_text .= "\t$target -> @targets\n" ;
+ }
+
+ $status_text .= "\nOut Map:\n\n" ;
+
+ my $out_ref = $self->{'out_map'} ;
+
+ foreach my $key ( sort keys %{$out_ref} ) {
+
+ my $out_addr = $out_ref->{$key} ;
+
+ my @out_addrs = ref $out_addr ? @{$out_addr} : ($out_addr) ;
+
+ $status_text .= "\t$key -> @out_addrs\n" ;
+ }
+
+ return $status_text ;
+}
+
+1 ;
--- /dev/null
+# File: Stem/Test/ConfTypes.pm
+
+# This file is part of Stem.
+# Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
+
+# Stem is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# Stem is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with Stem; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# For a license to use the Stem under conditions other than those
+# described here, to purchase support for this software, or to purchase a
+# commercial warranty contract, please contact Stem Systems at:
+
+# Stem Systems, Inc. 781-643-7504
+# 79 Everett St. info@stemsystems.com
+# Arlington, MA 02474
+# USA
+
+package Stem::Test::ConfTypes ;
+
+my $attr_spec = [
+
+ {
+ 'name' => 'bool_attr',
+ 'type' => 'boolean',
+ 'help' => <<HELP,
+Boolean attribute for testing Stem::Class
+HELP
+ },
+ {
+ 'name' => 'list_attr',
+ 'type' => 'list',
+ 'help' => <<HELP,
+List attribute for testing Stem::Class
+HELP
+ },
+ {
+ 'name' => 'hash_attr',
+ 'type' => 'hash',
+ 'help' => <<HELP,
+Hash attribute for testing Stem::Class
+HELP
+ },
+ {
+ 'name' => 'lol_attr',
+ 'type' => 'LoL',
+ 'help' => <<HELP,
+List of Lists attribute for testing Stem::Class
+HELP
+ },
+ {
+ 'name' => 'loh_attr',
+ 'type' => 'LoH',
+ 'help' => <<HELP,
+List of Hashes attribute for testing Stem::Class
+HELP
+ },
+ {
+ 'name' => 'hol_attr',
+ 'type' => 'HoL',
+ 'help' => <<HELP,
+Hash of Lists attribute for testing Stem::Class
+HELP
+ },
+ {
+ 'name' => 'hoh_attr',
+ 'type' => 'HoH',
+ 'help' => <<HELP,
+Hash of Hashes attribute for testing Stem::Class
+HELP
+ },
+] ;
+
+sub new {
+
+ my( $class ) = shift ;
+
+ my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
+ return $self unless ref $self ;
+
+#use YAML ;
+
+# warn Dump $self ;
+
+ return( $self ) ;
+}
+
+1 ;
--- /dev/null
+# File: Stem/Test/Echo.pm
+
+# This file is part of Stem.
+# Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
+
+# Stem is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# Stem is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with Stem; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# For a license to use the Stem under conditions other than those
+# described here, to purchase support for this software, or to purchase a
+# commercial warranty contract, please contact Stem Systems at:
+
+# Stem Systems, Inc. 781-643-7504
+# 79 Everett St. info@stemsystems.com
+# Arlington, MA 02474
+# USA
+
+
+package Stem::Test::Echo ;
+
+use strict ;
+
+my $attr_spec = [ { } ];
+
+sub new {
+
+ my( $class ) = shift ;
+
+ my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
+ return $self unless ref $self ;
+
+ return $self ;
+}
+
+# send this cell messages if you want test default delivery speed
+# this will handle all messages not covered by other methods
+
+sub msg_in {
+
+ my ( $self, $msg ) = @_ ;
+
+ my $reply_msg = $msg->reply() ;
+
+ $reply_msg->dispatch() ;
+
+ return ;
+}
+
+# send this cell data messages if you want to just echo the data
+
+sub data_in {
+
+ my ( $self, $msg ) = @_ ;
+
+#print $msg->dump( 'ECHO data_in' ) ;
+
+ my $reply_msg = $msg->reply(
+ type => 'data',
+ data => $msg->data(),
+ ) ;
+
+#print $reply_msg->dump( 'ECHO data reply' ) ;
+
+ $reply_msg->dispatch() ;
+
+ return ;
+}
+
+# send this cell 'echo' type messages if you want test plain reply speed
+
+sub echo_in {
+
+ my ( $self, $msg ) = @_ ;
+
+ $msg->reply()->dispatch() ;
+
+ return ;
+}
+
+# send this cell 'echo_data' type messages if you want test reply with data
+
+sub echo_data_in {
+
+ my ( $self, $msg ) = @_ ;
+
+#print $msg->dump( 'ECHO_DATA' ) ;
+
+ my $data = $msg->data() ;
+
+ my $reply_msg = $msg->reply( data => { echo => $data } ) ;
+
+ $reply_msg->dispatch() ;
+
+ return ;
+}
+
+# send this cell 'echo' cmd messages if you want test plain command speed
+
+sub echo_cmd {
+
+ my ( $self ) = @_ ;
+
+ return '' ;
+}
+
+# send this cell 'echo_data' cmd messages if you want test command
+# speed with data.
+
+sub echo_data_cmd {
+
+ my ( $self, $msg ) = @_ ;
+
+ my $data = $msg->data() ;
+
+ return $data ;
+}
+
+1 ;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Stem::Test::Echo - This cell accepts messages and sends back reply
+messages or command data. It can be used to test message receipt,
+replies, and command returns and to benchmark message throughput.
+
+=head1 SYNOPSIS
+
+ [
+ 'class' => 'Stem::Test::Echo',
+ 'name' => 'test_echo',
+ ],
+
+=head1 USAGE
+
+This cell accepts various messages, all of which will echo some
+message back to the sender.
+
+ An echo type message will do a reply with no data.
+
+ An echo_data type message will do a reply with the sent data.
+
+ An echo command message will return a null string.
+
+ An echo_data command message will return the data.
+
+ Any other message type or command will do a plain reply like
+ an 'echo' type message.
+
+=cut
--- /dev/null
+# File: Stem/Test/Flow.pm
+
+# This file is part of Stem.
+# Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
+
+# Stem is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# Stem is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with Stem; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# For a license to use the Stem under conditions other than those
+# described here, to purchase support for this software, or to purchase a
+# commercial warranty contract, please contact Stem Systems at:
+
+# Stem Systems, Inc. 781-643-7504
+# 79 Everett St. info@stemsystems.com
+# Arlington, MA 02474
+# USA
+
+package Stem::Test::Flow ;
+
+use Test::More tests => 30 ;
+
+use base 'Stem::Cell' ;
+
+my $attr_spec = [
+
+ {
+ 'name' => 'reg_name',
+ 'help' => <<HELP,
+This is the name under which this Cell was registered.
+HELP
+ },
+
+ {
+ 'class' => 'Stem::Cell',
+ 'name' => 'cell_attr',
+ 'help' => <<HELP,
+This value is the attributes for the included Stem::Cell which handles
+cloning, async I/O and pipes.
+HELP
+ },
+
+] ;
+
+sub new {
+
+ my( $class ) = shift ;
+
+ my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
+ return $self unless ref $self ;
+
+ my $flow_text = <<FLOW ;
+
+ meth1 ;
+ meth2( 1, a ) ;
+ if if1 {
+ meth3 ;
+ }
+
+ unless if1 {
+ meth_bad ;
+ }
+
+ while while1 {
+ meth4 ;
+ }
+
+ until until1 {
+
+ unless unless1 {
+
+ meth5 ;
+ }
+ else {
+
+ meth6 ;
+ }
+ }
+
+ while while2 {
+ next ;
+ }
+
+ next_ok ;
+
+ LABEL1 :
+ while while3 {
+
+ while while4 {
+
+ next LABEL1 ;
+ }
+ }
+
+ LABEL2 :
+ until until2 {
+
+ if if2 {
+
+ last LABEL2 ;
+ }
+ }
+
+ last_ok ;
+
+ delay_time ;
+ delay 1 ;
+ delay_done( 1 ) ;
+
+ delay delay_set( 2 ) ;
+ delay_done( 2 ) ;
+
+ msg1 ;
+ get_msg1 ;
+
+
+ exit_meth ;
+FLOW
+
+ $self->cell_flow_init( 'test', $flow_text ) ;
+
+ $self->cell_flow_go_in() ;
+
+ return $self ;
+}
+
+sub meth1 {
+ ok(1, 'plain method') ;
+ return ;
+}
+
+sub meth2 {
+ my( $self, $arg1, $arg2 ) = @_ ;
+ ok( $arg1 ==1 && $arg2 eq 'a', 'methods with args' ) ;
+ return ;
+}
+
+sub if1 {
+ ok(1, 'if condition') ;
+ return 1 ;
+}
+
+sub meth3 {
+ ok(1, 'method in block' ) ;
+ return ;
+}
+
+sub meth_bad {
+ ok(0, 'then block was called' ) ;
+ return ;
+}
+
+my $w1 ;
+
+sub while1 {
+ ok(1, 'while condition') ;
+ return 1 if $w1++ < 2 ;
+
+ return ;
+}
+
+sub meth4 {
+ ok(1, 'method in while' ) ;
+ return ;
+}
+
+my $u1 ;
+my $u2 ;
+
+sub until1 {
+ ok(1, 'until condition') ;
+ return $u1 ;
+}
+
+sub unless1 {
+ ok(1, 'unless condition') ;
+ return $u2 ;
+}
+
+sub meth5 {
+ ok(1, 'method in unless' ) ;
+
+ $u2++ ;
+ return ;
+}
+
+sub meth6 {
+ ok(1, 'method in else' ) ;
+
+ $u1++ ;
+}
+
+my $w3 ;
+
+sub while3 {
+ ok(1, 'outer while condition') ;
+ return 1 if $w3++ < 1 ;
+
+ return ;
+}
+
+my $w4 ;
+
+sub while4 {
+ ok(1, 'inner while condition') ;
+ return 1 if $w4++ < 1 ;
+
+ return ;
+}
+
+sub next_ok {
+
+ ok( 1, 'next' ) ;
+
+ return ;
+}
+
+
+my $w2 ;
+
+sub while2 {
+ ok(1, 'while condition') ;
+ return 1 if $w1++ < 1 ;
+
+ return ;
+}
+
+sub until2 {
+
+ return ;
+}
+
+sub if2 {
+ return 1 ;
+}
+
+sub last_ok {
+
+ ok( 1, 'last' ) ;
+
+ return ;
+}
+
+
+my $delay_time ;
+
+sub delay_time {
+
+ $delay_time = time ;
+
+ return ;
+}
+
+sub delay_done {
+
+ my( $self, $delta ) = @_ ;
+
+ my $time = time ;
+
+ $delta ||= 1 ;
+
+#print "$time $delay_time\n" ;
+
+ ok( $time - $delay_time >= $delta, 'delay done' ) ;
+
+ return ;
+}
+
+
+sub delay_set {
+
+ my( $self, $delay ) = @_ ;
+
+ ok( 1, 'delay set method' ) ;
+
+ return $delay || 1 ;
+}
+
+sub msg1 {
+
+ my ( $self ) = @_ ;
+
+ ok(1, 'message method' ) ;
+
+ my $msg = Stem::Msg->new( to => $self->{'reg_name'},
+ from => $self->{'reg_name'},
+ type => 'flow_msg'
+ ) ;
+
+#print $msg->dump( 'MSG1' ) ;
+
+ return $msg ;
+
+}
+
+sub flow_msg_in {
+
+ my ( $self, $msg ) = @_ ;
+
+#print $msg->dump( 'FLOW' ) ;
+ ok(1, 'flow message in' ) ;
+
+ my $reply = $msg->reply() ;
+
+#print $reply->dump( 'reply' ) ;
+
+ $reply->dispatch() ;
+
+ return ;
+}
+
+sub get_msg1 {
+
+ my ( $self, $msg ) = @_ ;
+
+ ok(1, 'message received' ) ;
+
+#print $msg->dump( 'GET' ) ;
+
+ return ;
+}
+
+sub exit_meth {
+ ok(1, 'exit method' ) ;
+
+ exit ;
+}
+
+1 ;
--- /dev/null
+# File: Stem/Test/PacketIO.pm
+
+# This file is part of Stem.
+# Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
+
+# Stem is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# Stem is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with Stem; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# For a license to use the Stem under conditions other than those
+# described here, to purchase support for this software, or to purchase a
+# commercial warranty contract, please contact Stem Systems at:
+
+# Stem Systems, Inc. 781-643-7504
+# 79 Everett St. info@stemsystems.com
+# Arlington, MA 02474
+# USA
+
+package Stem::Test::PacketIO ;
+
+use Test::More ;
+
+use Stem::Route qw( register_cell unregister_cell ) ;
+use Stem::SockMsg ;
+
+use base 'Stem::Cell' ;
+
+my $attr_spec = [
+
+ {
+ 'name' => 'reg_name',
+ 'help' => <<HELP,
+This is the name under which this Cell was registered.
+HELP
+ },
+
+ {
+ 'name' => 'port',
+ 'default' => 8889,
+ 'help' => <<HELP,
+The port to use for the SockMsg cells.
+HELP
+ },
+ {
+ 'name' => 'write_addr',
+ 'help' => <<HELP,
+The Cell address of a sending port
+HELP
+ },
+ {
+ 'name' => 'cell_attr',
+ 'class' => 'Stem::Cell',
+ 'help' => <<HELP,
+Argument list passed to Stem::Cell for this Cell
+HELP
+ },
+] ;
+
+
+my @msg_data = (
+ "Packet scalar",
+ \"Packet ref",
+ { foo => 2 },
+ [ qw( a b c ) ],
+ bless( { abc => 1 }, 'PIO_class' ),
+ { bar => 'xyz', qwert => 3 },
+ {
+ list => [ 1 .. 4 ],
+ hash => { qwert => 3 },
+ }
+) ;
+
+my @codecs = qw( YAML Storable Data::Dumper SimpleHash ) ;
+#my @codecs = qw( SimpleHash ) ;
+@codecs = grep { eval "require Stem::Codec::$_" } @codecs ;
+
+plan tests => @msg_data * @codecs ;
+
+sub new {
+
+ my( $class ) = shift ;
+
+ my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
+ return $self unless ref $self ;
+
+ my $flow_text = <<FLOW ;
+
+ WHILE codecs_left {
+
+ create_sock_msg_pair ;
+ DELAY 1 ;
+ send_msg ;
+ STOP ;
+ }
+ STOP ;
+FLOW
+
+ $self->cell_flow_init( 'test', $flow_text ) ;
+
+ $self->cell_flow_go_in() ;
+
+ return $self ;
+}
+
+sub send_msg {
+
+ my( $self ) = @_ ;
+
+ my $codec = $self->{'codec'} ;
+
+# we send to the client hence to the server, on to echo, back to the
+# server and through the client all the way to here
+
+ foreach my $data ( @msg_data ) {
+
+ if ( $codec eq 'SimpleHash' ) {
+
+ if ( ref $data ne 'HASH' ) {
+
+ ok( 1,
+ 'skip SimpleHash only allows hash refs for data') ;
+ next ;
+ }
+
+ if ( grep ref $_, values %{$data} ) {
+
+ ok( 1,
+ 'skip SimpleHash only allows single level hashes for data') ;
+ next ;
+ }
+ }
+
+ my $msg = Stem::Msg->new(
+ 'to' => "client_$codec",
+ 'from' => $self->{'reg_name'},
+ 'type' => 'data',
+ 'data' => $data,
+ ) ;
+
+#print $msg->dump("MSG OUT") ;
+ $msg->dispatch() ;
+
+ push( @{$self->{'sent_data'}}, $data ) ;
+ }
+
+ return ;
+}
+
+sub data_in {
+
+ my( $self, $msg ) = @_ ;
+
+#print $msg->dump( 'PACKET IN' ) ;
+
+ my $recv_data = $msg->data() ;
+
+ my $sent_data = shift @{$self->{'sent_data'}} ;
+
+#print "SENT [$sent_data]\nGOT[$recv_data]\n" ;
+
+ my $data_type = ref $sent_data || 'scalar' ;
+
+ is_deeply( $recv_data, $sent_data, "$self->{'codec'} - $data_type " ) ;
+
+ unless ( @{$self->{'sent_data'}} ) {
+
+ $self->destroy_sock_msg_pair() ;
+ $self->cell_flow_go_in() ;
+ }
+}
+
+sub test_done {
+
+ return 'FLOW_STOP' ;
+}
+
+sub codecs_left {
+
+ my( $self ) = @_ ;
+
+exit unless @codecs ;
+
+#die "CODECS END"
+
+ return( $self->{codec} = shift @codecs ) ;
+}
+
+sub create_sock_msg_pair {
+
+ my( $self ) = @_ ;
+
+ my $codec = $self->{'codec'} ;
+
+#print "CREATE [$codec]\n" ;
+
+ my $server_name = "server_$codec" ;
+
+ my $server_sock = Stem::SockMsg->new(
+ reg_name => $server_name,
+ port => ++$self->{port},
+ server => 1,
+ cell_attr => [
+ 'data_addr' => 'echo',
+ 'codec' => $codec,
+ ],
+ ) ;
+
+#print "SERVER [$server_sock]\n" ;
+ die $server_sock unless ref $server_sock ;
+ my $err = register_cell( $server_sock, $server_name ) ;
+ $err and die "register error: $err" ;
+
+ $self->{server_cell} = $server_sock ;
+ $self->{server_name} = $server_name ;
+
+ my $client_name = "client_$codec" ;
+
+ my $client_sock = Stem::SockMsg->new(
+ reg_name => $client_name,
+ port => $self->{port},
+ connect_now => 1,
+ sync => 1,
+ cell_attr => [
+ 'data_addr' => 'packet_io',
+ 'codec' => $codec,
+ ],
+ ) ;
+#print "CLIENT [$client_sock]\n" ;
+
+ die $client_sock unless ref $client_sock ;
+ register_cell( $client_sock, $client_name ) ;
+ $self->{client_cell} = $client_sock ;
+ $self->{client_name} = $client_name ;
+
+ return ;
+}
+
+sub destroy_sock_msg_pair {
+
+ my( $self ) = @_ ;
+
+ my $codec = $self->{'codec'} ;
+
+#print "DESTROY [$codec]\n" ;
+
+ foreach my $type ( qw( server client ) ) {
+
+ my $sock_msg = delete $self->{"${type}_cell"} ;
+# my $sock_msg = delete $self->{"${type}_$codec"} ;
+ unregister_cell( $sock_msg ) ;
+ $sock_msg->shut_down() ;
+ }
+}
+
+1 ;
--- /dev/null
+# File: Stem/Test/UDP.pm
+
+# This file is part of Stem.
+# Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
+
+# Stem is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# Stem is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with Stem; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# For a license to use the Stem under conditions other than those
+# described here, to purchase support for this software, or to purchase a
+# commercial warranty contract, please contact Stem Systems at:
+
+# Stem Systems, Inc. 781-643-7504
+# 79 Everett St. info@stemsystems.com
+# Arlington, MA 02474
+# USA
+
+package Stem::Test::UDP ;
+
+use Test::More tests => 7 ;
+
+my $attr_spec = [
+
+ {
+ 'name' => 'reg_name',
+ 'help' => <<HELP,
+This is the name under which this Cell was registered.
+HELP
+ },
+
+ {
+ 'name' => 'send_addr',
+ 'help' => <<HELP,
+The Cell address of a sending port
+HELP
+ },
+ {
+ 'name' => 'send_host',
+ 'help' => <<HELP,
+The UDP packet is sent to this host if the send message has no host
+HELP
+ },
+ {
+ 'name' => 'send_port',
+ 'help' => <<HELP,
+The UDP packet is sent to this port if the send message has no port
+HELP
+ },
+
+] ;
+
+sub new {
+
+ my( $class ) = shift ;
+
+ my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
+ return $self unless ref $self ;
+
+
+ $self->{'udp_send_obj'} = Stem::UDPMsg->new() ;
+
+#print $self->{'udp_send_obj'}->status_cmd() ;
+
+# create a private udp server object and save it.
+
+ $self->{'udp_recv_obj'} = Stem::UDPMsg->new(
+ object => $self,
+ bind_port => 9998,
+ bind_host => '',
+ server => 1,
+ timeout => 1,
+ ) ;
+
+#print $self->{'udp_recv_obj'}->status_cmd() ;
+
+ my $err = $self->{'udp_send_obj'}->send( "LOCAL send",
+ send_host => 'local_host',
+ send_port => 9998,
+ ) ;
+
+ ok( $err, 'bad host lookup' ) ;
+
+ $err = $self->{'udp_send_obj'}->send( \"LOCAL send",
+ send_host => 'localhost',
+ send_port => 9998,
+ ) ;
+
+ ok( !$err, 'good host lookup' ) ;
+
+ return $self ;
+}
+
+sub udp_received {
+
+ my( $self, $udp_data, $from_port, $from_host ) = @_ ;
+
+ my $ok = ${$udp_data} =~ /LOCAL send/ ;
+
+ ok( $ok, 'udp received') ;
+
+#print "UDP [${$udp_data}]\n" ;
+
+# now send out a bad and a good message to the udp send cell
+
+ my $udp_msg = Stem::Msg->new(
+ 'to' => $self->{'send_addr'},
+ 'from' => $self->{'reg_name'},
+ 'cmd' => 'send',
+ 'data' => {
+ 'data' => \"foo",
+ 'send_port' => $self->{'send_port'},
+ }
+ ) ;
+
+ $udp_msg->dispatch() ;
+
+ $udp_msg = Stem::Msg->new(
+ 'to' => $self->{'send_addr'},
+ 'from' => $self->{'reg_name'},
+ 'cmd' => 'send',
+ 'data' => {
+ 'data' => \"REMOTE foo",
+ 'send_port' => $self->{'send_port'},
+ 'send_host' => 'localhost',
+ }
+ ) ;
+
+#print $udp_msg->dump( 'UDP msg' ) ;
+
+ $udp_msg->dispatch() ;
+}
+
+sub udp_timeout {
+
+ my( $self ) = @_ ;
+
+ ok(1, 'udp timeout') ;
+
+# kill the receiver object so we can exit eventually
+
+ $self->{'udp_recv_obj'}->shut_down() ;
+ delete $self->{'udp_recv_obj'} ;
+
+ return ;
+}
+
+sub udp_data_in {
+
+ my( $self, $msg ) = @_ ;
+
+ ok(1, 'udp data in called') ;
+
+ my $udp_data = $msg->data()->{data} ;
+
+ my $ok = ${$udp_data} =~ /REMOTE/ ;
+
+#print $msg->dump( 'UDP IN' ) ;
+
+ ok( $ok, 'udp data in') ;
+
+# send a shutdown message to the udp receiver cell. with no more
+# events it will cause the event loop to fall through and exit the
+# test script.
+
+ my $udp_msg = Stem::Msg->new(
+ 'to' => $msg->from(),
+ 'from' => $self->{'reg_name'},
+ 'cmd' => 'shut_down',
+ ) ;
+
+ $udp_msg->dispatch() ;
+}
+
+sub udp_timeout_in {
+
+ my( $self, $msg ) = @_ ;
+
+ ok(1, 'udp timeout in') ;
+
+#print $msg->dump( 'UDP timeout IN' ) ;
+
+ return ;
+}
+
+sub response_in {
+
+ my( $self, $msg ) = @_ ;
+
+#print $msg->dump( 'UDP DATA' ) ;
+
+ my $data = $msg->data() ;
+
+ my $ok = ${$data} =~ /Missing send_host/ ;
+
+ ok($ok, 'udp error response') ;
+}
+
+1 ;
--- /dev/null
+# File: Stem/Trace.pm
+
+# This file is part of Stem.
+# Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
+
+# Stem is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# Stem is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with Stem; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# For a license to use the Stem under conditions other than those
+# described here, to purchase support for this software, or to purchase a
+# commercial warranty contract, please contact Stem Systems at:
+
+# Stem Systems, Inc. 781-643-7504
+# 79 Everett St. info@stemsystems.com
+# Arlington, MA 02474
+# USA
+
+package Stem::Trace ;
+
+use strict;
+
+use Stem::Vars ;
+use Stem::Log::Entry ;
+
+sub import {
+
+ my( $class, %trace_args ) = @_ ;
+
+ $class = caller ;
+
+ my $sub = $trace_args{ 'sub' } || 'Trace' ;
+ my $type = $trace_args{ 'type' } || 'textlist' ;
+ my $def_level = $trace_args{ 'level' } || 5 ;
+ my $def_label = $trace_args{ 'label' } || 'trace' ;
+ my $def_log = $trace_args{ 'log' } || 'trace' ;
+ my $def_env = $trace_args{ 'env' } || "$class\::$sub" ;
+ my $def_env_level = $trace_args{ 'env_level' } || 0 ;
+ my $def_prefix = $trace_args{ 'prefix' } || '%P-%L - ' ;
+
+ no strict 'refs';
+
+ if ( $type eq 'args' ) {
+
+ *{ "${class}::$sub" } = sub {
+
+ return if
+ ( $Stem::Vars::Env{ $def_env } || 0 ) <
+ $def_env_level ;
+
+ my $prefix = $def_prefix ;
+ my( $line_num ) = (caller)[2] ;
+
+ $prefix =~ s/%P/$class/ ;
+ $prefix =~ s/%L/$line_num/ ;
+
+# if only 1 arg, it is text.
+# if 2 args, it is level, text
+# if 3 args, it is label, level, text
+
+ my $text = pop ;
+ my $level = pop || $def_level ;
+ my $label = pop || $def_label ;
+ my $log = pop || $def_log ;
+
+ Stem::Log::Entry->new (
+ 'logs' => $log,
+ 'level' => $level,
+ 'label' => $label,
+ 'text' => "$prefix$text\n"
+ ) ;
+ } ;
+
+ return ;
+ }
+
+ if ( $type eq 'keyed' ) {
+
+ *{ "${class}::$sub" } = sub {
+
+ my ( %args ) = @_;
+
+ my $env = $args{ 'env' } || $def_env ;
+ my $env_level = $args{ 'env_level' } || $def_env_level ;
+
+ return if
+ ( $Stem::Vars::Env{ $env } || 0 ) < $env_level ;
+
+ my $text = $args{ 'text' } || '' ;
+ my $log = $args{ 'log' } || $def_log ;
+ my $level = $args{ 'level' } || $def_level ;
+ my $label = $args{ 'label' } || $def_label ;
+ my $prefix = $args{ 'prefix' } || $def_prefix ;
+
+ my( $line_num ) = (caller)[2] ;
+ $prefix =~ s/%P/$class/ ;
+ $prefix =~ s/%L/$line_num/ ;
+
+ Stem::Log::Entry->new (
+ 'logs' => $log,
+ 'level' => $level,
+ 'label' => $label,
+ 'text' => "$prefix$text\n",
+ ) ;
+ } ;
+
+ return ;
+ }
+
+ if ( $type eq 'textlist' ) {
+
+ *{ "${class}::$sub" } = sub {
+
+ return if
+ ( $Stem::Vars::Env{ $def_env } || 0 ) <
+ $def_env_level ;
+
+ my $text = join '', @_ ;
+
+ my( $line_num ) = (caller)[2] ;
+
+ my $prefix = $def_prefix ;
+
+ $prefix =~ s/%P/$class/ ;
+ $prefix =~ s/%L/$line_num/ ;
+
+
+ Stem::Log::Entry->new (
+ 'logs' => $def_log,
+ 'level' => $def_level,
+ 'label' => $def_label,
+ 'text' => "$prefix$text\n",
+ ) ;
+ } ;
+
+ return ;
+ }
+}
+
+1 ;
--- /dev/null
+# File: Stem/TtySock.pm
+
+# This file is part of Stem.
+# Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
+
+# Stem is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# Stem is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with Stem; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# For a license to use the Stem under conditions other than those
+# described here, to purchase support for this software, or to purchase a
+# commercial warranty contract, please contact Stem Systems at:
+
+# Stem Systems, Inc. 781-643-7504
+# 79 Everett St. info@stemsystems.com
+# Arlington, MA 02474
+# USA
+
+package Stem::TtySock ;
+
+use strict ;
+use Carp ;
+
+use Stem::AsyncIO ;
+#use Debug ;
+
+my $attr_spec = [
+ {
+ 'name' => 'port',
+ 'default' => 10_000,
+ 'env' => 'tty_port',
+ 'help' => <<HELP,
+HELP
+ },
+
+ {
+ 'name' => 'host',
+ 'default' => 'localhost',
+ 'env' => 'tty_host',
+ 'help' => <<HELP,
+HELP
+ },
+
+] ;
+
+sub new {
+
+ my( $class ) = shift ;
+
+ my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
+ return $self unless ref $self ;
+
+ my $aio = Stem::AsyncIO->new(
+
+ 'object' => $self,
+ 'read_fh' => \*STDIN,
+ 'write_fh' => \*STDOUT,
+ 'read_method' => 'stdin_read',
+ 'closed_method' => 'stdin_closed',
+ ) ;
+
+ $self->{'aio'} = $aio ;
+
+ my $sock_obj = Stem::Socket->new(
+ 'object' => $self,
+ 'host' => $self->{'host'},
+ 'port' => $self->{'port'},
+ 'server' => $self->{'server'},
+ ) ;
+
+ $self->{'sock_obj'} = $sock_obj ;
+
+#Debug "TTYSock new" ;
+
+ return( $self ) ;
+}
+
+
+sub connected {
+
+ my( $self, $connected_sock ) = @_ ;
+
+ my( $type, $sock_buf ) ;
+
+
+ $self->{'connected'} = 1 ;
+ $self->{'sock'} = $connected_sock ;
+
+ $type = $self->{'sock_obj'}->type() ;
+
+ if ( $type eq 'server' ) {
+
+ $self->{'sock_obj'}->stop_listening() ;
+ }
+
+ $sock_buf = Stem::AsyncIO->new(
+
+ 'object' => $self,
+ 'fh' => $connected_sock,
+ 'read_method' => 'socket_read',
+ 'closed_method' => 'socket_closed',
+ ) ;
+
+ $self->{'sock_buf'} = $sock_buf ;
+}
+
+sub socket_read {
+
+ my( $self, $data_ref ) = @_ ;
+
+ $self->{'aio'}->write( $data_ref ) ;
+}
+
+sub socket_closed {
+
+ my( $self ) = @_ ;
+
+ $self->{'connected'} = 0 ;
+
+ $self->{'sock_buf'}->shut_down() ;
+
+ if ( $self->{'sock_obj'}->type() eq 'server' ) {
+
+ $self->{'sock_obj'}->start_listening() ;
+ }
+ else {
+
+ $self->{'sock_obj'}->connect_to() ;
+ }
+}
+
+sub stdin_read {
+
+ my( $self, $data_ref ) = @_ ;
+
+ unless ( $self->{'connected'} ) {
+
+ print "TTY::Sock not connected\n" ;
+ return ;
+ }
+
+ $self->{'sock_buf'}->write( $data_ref ) ;
+}
+
+sub stdin_closed {
+
+ my( $self ) = @_ ;
+
+
+# print "stdin closed\n" ;
+
+ *STDIN->clearerr() ;
+}
+
+
+1 ;
--- /dev/null
+# File: Stem/UDPMsg.pm
+
+# This file is part of Stem.
+# Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
+
+# Stem is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# Stem is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with Stem; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# For a license to use the Stem under conditions other than those
+# described here, to purchase support for this software, or to purchase a
+# commercial warranty contract, please contact Stem Systems at:
+
+# Stem Systems, Inc. 781-643-7504
+# 79 Everett St. info@stemsystems.com
+# Arlington, MA 02474
+# USA
+
+package Stem::UDPMsg ;
+
+use strict ;
+
+use Data::Dumper ;
+use IO::Socket ;
+
+my $attr_spec = [
+
+ {
+ 'name' => 'reg_name',
+ 'help' => <<HELP,
+The registration name for this Cell
+HELP
+ },
+
+ {
+ 'name' => 'bind_host',
+ 'help' => <<HELP,
+The UDP socket is bound to this host for receiving or sending packets
+HELP
+ },
+
+ {
+ 'name' => 'bind_port',
+ 'help' => <<HELP,
+The UDP socket is bound to this port for receiving or sending packets
+HELP
+ },
+ {
+ 'name' => 'send_host',
+ 'help' => <<HELP,
+The UDP packet is sent to this host if the send message has no host
+HELP
+ },
+ {
+ 'name' => 'send_port',
+ 'help' => <<HELP,
+The UDP packet is sent to this port if the send message has no port
+HELP
+ },
+ {
+ 'name' => 'bind_port',
+ 'help' => <<HELP,
+The UDP socket is bound to this port for receiving or sending packets
+HELP
+ },
+ {
+ 'name' => 'server',
+ 'type' => 'boolean',
+ 'help' => <<HELP,
+Marks this socket as a server and it expect to receive UDP packets
+HELP
+ },
+ {
+ 'name' => 'max_recv_size',
+ 'default' => 4096,
+ 'help' => <<HELP,
+Maximum size of received UDP packets.
+
+HELP
+ },
+ {
+ 'name' => 'data_addr',
+ 'help' => <<HELP,
+Send received UDP packets as 'udp_data' type messages to this address
+HELP
+ },
+ {
+ 'name' => 'error_addr',
+ 'help' => <<HELP,
+Send received UDP errors as 'udp_error' type messages to this address
+HELP
+ },
+ {
+ 'name' => 'timeout_addr',
+ 'help' => <<HELP,
+Send UDP timeouts as 'udp_timeout' type messages to this address
+HELP
+ },
+ {
+ 'name' => 'object',
+ 'help' => <<HELP,
+This object will get the callbacks
+HELP
+ },
+ {
+ 'name' => 'timeout',
+ 'help' => <<HELP,
+This sets the timeout period to wait for UDP data. If no data has been
+received since the timer started, a timeout message or callback will
+be triggered.
+HELP
+ },
+ {
+ 'name' => 'recv_method',
+ 'default' => 'udp_received',
+ 'help' => <<HELP,
+This method will be called in the object when a UDP packet has been received
+HELP
+ },
+ {
+ 'name' => 'error_method',
+ 'default' => 'udp_error',
+ 'help' => <<HELP,
+This method will be called in the object when a UDP had been detected
+HELP
+ },
+ {
+ 'name' => 'timeout_method',
+ 'default' => 'udp_timeout',
+ 'help' => <<HELP,
+This method will be called in the object when no UDP data has been received
+after the timeout period.
+HELP
+ },
+ {
+ 'name' => 'log_name',
+ 'help' => <<HELP,
+Log to send store sent and received messages
+HELP
+ },
+] ;
+
+
+sub new {
+
+ my( $class ) = shift ;
+
+ my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
+ return $self unless ref $self ;
+
+ my $info_text = '' ;
+
+ my $socket = IO::Socket::INET->new( 'Proto' => 'udp' ) ;
+ $self->{'socket'} = $socket ;
+
+ if ( my $bind_port = $self->{'bind_port'} ) {
+
+ $info_text .= "Port: $bind_port\n" ;
+
+ my $bind_ip ;
+ my $bind_host = $self->{'bind_host'} ;
+
+ if ( length $bind_host ) {
+
+ $bind_ip = inet_aton( $bind_host ) ;
+ $info_text .= "Host: $bind_host\n" ;
+ }
+ else {
+
+ $bind_ip = INADDR_ANY ;
+ $info_text .= "Host: INADDR_ANY\n" ;
+ }
+
+ $socket->bind( $bind_port, $bind_ip ) ;
+ }
+
+ my @timeout_args = ( $self->{'timeout'} ) ?
+ ( 'timeout' => $self->{'timeout'} ) : () ;
+
+
+ if ( $self->{'server'} ) {
+
+ $self->{'read_event'} = Stem::Event::Read->new(
+ 'object' => $self,
+ 'fh' => $socket,
+ @timeout_args,
+ ) ;
+ }
+
+ my $reg_name = $self->{'reg_name'} || 'NONE' ;
+ my $sock_host = $socket->sockhost ;
+ my $sock_port = $socket->sockport ;
+
+ $self->{'info'} = <<INFO ;
+---------------------
+UDPMsg
+
+Cell name: $reg_name
+Port: $sock_port
+---
+$info_text
+---------------------
+
+INFO
+
+ return $self ;
+}
+
+sub status_cmd {
+
+ my ( $self ) = @_ ;
+
+ return $self->{'info'} ;
+}
+
+
+sub readable {
+
+ my( $self ) = @_ ;
+
+#print "UDP readable\n" ;
+
+ my $udp_data ;
+
+ my $udp_addr = $self->{'socket'}->recv( $udp_data,
+ $self->{'max_recv_size'} ) ;
+
+#print "UDP READ [$udp_data]\n" ;
+
+# handle errors
+
+ unless( defined( $udp_addr ) ) {
+
+ if ( my $error_addr = $self->{'error_addr'} ) {
+
+ my $msg = Stem::Msg->new(
+ 'to' => $error_addr,
+ 'from' => $self->{'from_addr'},
+ 'type' => 'udp_error',
+ 'data' => \"$!",
+ ) ;
+
+#print $msg->dump( 'UDP error' ) ;
+ $msg->dispatch() ;
+ return ;
+ }
+
+# send the data via a callback
+
+ if ( my $obj = $self->{'object'} ) {
+
+ my $method = $self->{'error_method'} ;
+ $obj->$method( \"$!" ) ;
+ }
+
+ return ;
+ }
+
+ my( $from_port, $from_host ) = unpack_sockaddr_in( $udp_addr ) ;
+
+ $from_host = inet_ntoa( $from_host ) ;
+
+# send out the data as a stem message
+
+#print "ADDR [$self->{'data_addr'}]\n" ;
+
+ if ( my $data_addr = $self->{'data_addr'} ) {
+
+ my $msg = Stem::Msg->new(
+ 'to' => $data_addr,
+ 'from' => $self->{'reg_name'},
+ 'type' => 'udp_data',
+ 'data' => {
+ 'data' => \$udp_data,
+ 'from_port' => $from_port,
+ 'from_host' => $from_host,
+ },
+ ) ;
+
+#print $msg->dump( 'UDP recv' ) ;
+ $msg->dispatch() ;
+ return ;
+ }
+
+# send the data via a callback
+
+ if ( my $obj = $self->{'object'} ) {
+
+ my $method = $self->{'recv_method'} ;
+ $obj->$method( \$udp_data, $from_port, $from_host ) ;
+ }
+
+ return ;
+}
+
+sub read_timeout {
+
+ my( $self ) = @_ ;
+
+#print "UDP timeout\n" ;
+
+# send out the timeout as a stem message
+
+ if ( my $timeout_addr = $self->{'timeout_addr'} ) {
+
+ my $msg = Stem::Msg->new(
+ 'to' => $timeout_addr,
+ 'from' => $self->{'reg_name'},
+ 'type' => 'udp_timeout',
+ ) ;
+
+#print $msg->dump( 'UDP timeout' ) ;
+ $msg->dispatch() ;
+ return ;
+ }
+
+# send the timeout via a callback
+
+ if ( my $obj = $self->{'object'} ) {
+
+ my $method = $self->{'timeout_method'} ;
+ $obj->$method() ;
+ }
+
+ return ;
+}
+
+
+sub send_cmd {
+
+ my ( $self, $msg ) = @_ ;
+
+#print $msg->dump( 'UDP send' ) ;
+ my $msg_data = $msg->data() ;
+
+ my $send_port = $msg_data->{'send_port'} || $self->{'send_port'} ;
+ my $send_host = $msg_data->{'send_host'} || $self->{'send_host'} ;
+
+ my $udp_data = $msg_data->{'data'} ;
+
+ return $self->_send( $udp_data, $send_port, $send_host ) ;
+}
+
+sub send {
+
+ my ( $self, $data, %args ) = @_ ;
+
+ my $send_port = $args{'send_port'} || $self->{'send_port'} ;
+ my $send_host = $args{'send_host'} || $self->{'send_host'} ;
+
+ return $self->_send( $data, $send_port, $send_host ) ;
+}
+
+sub _send {
+
+ my( $self, $data, $port, $host ) = @_ ;
+
+ $host or return "Missing send_host for UDP send" ;
+ $port or return "Missing send_port for UDP send" ;
+
+#print "P $port H $host\n" ;
+
+ my $host_ip = inet_aton( $host ) ;
+ $host_ip or return "Bad host '$host'" ;
+
+ my $send_addr = pack_sockaddr_in( $port, $host_ip ) ;
+
+ $data = $$data if ref $data ;
+
+ my $byte_cnt = $self->{'socket'}->send( $data, 0, $send_addr ) ;
+
+#print "BYTES [$byte_cnt]\n" ;
+
+ return "send error: $!" unless defined $byte_cnt ;
+ return ;
+}
+
+
+sub shut_down_cmd {
+
+ my ( $self, $msg ) = @_ ;
+
+#print $msg->dump( 'SHUT' ) ;
+
+ $self->shut_down() ;
+
+ return ;
+}
+
+sub shut_down {
+
+ my ( $self ) = @_ ;
+
+ if ( my $read_event = delete $self->{'read_event'} ) {
+
+ $read_event->cancel() ;
+ }
+
+ delete $self->{'object'} ;
+
+ my $socket = delete $self->{'socket'} ;
+
+ close $socket ;
+}
+
+1 ;
--- /dev/null
+# File: Stem/Util.pm
+
+# This file is part of Stem.
+# Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
+
+# Stem is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# Stem is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with Stem; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# For a license to use the Stem under conditions other than those
+# described here, to purchase support for this software, or to purchase a
+# commercial warranty contract, please contact Stem Systems at:
+
+# Stem Systems, Inc. 781-643-7504
+# 79 Everett St. info@stemsystems.com
+# Arlington, MA 02474
+# USA
+
+package Stem::Util ;
+
+use strict ;
+use Carp ;
+
+=head1 Stem::Util
+
+This file includes two subroutines: read_file and write_file.
+
+=cut
+
+=head2 read_file
+
+read_file is a utility sub to slurp in a file.
+
+It returns a list of lines when called in list context.
+It returns one big string when called in scalar context.
+
+=cut
+
+# utility sub to slurp in a file. list/scalar context determines either
+# list of lines or long single string
+
+sub read_file {
+
+ my( $file_name ) = shift ;
+
+ local( *FH ) ;
+ open( FH, $file_name ) || carp "can't open $file_name $!" ;
+
+ return <FH> if wantarray ;
+
+ my $buf ;
+
+ sysread( FH, $buf, -s FH ) ;
+ return $buf ;
+}
+
+=head2 load_file
+
+load_file is a utility sub to load a file of data. It reads in a file
+and converts it to an internal form according to the first line of the
+file. The default file format is Perl data and eval is used to convert
+it. These other formats are also supported:
+
+ YAML
+
+=cut
+
+sub load_file {
+
+ my( $file_name ) = shift ;
+
+ my $text = read_file( $file_name ) ;
+
+ my @load_vals ;
+
+ if ( $text =~ /^.*#YAML/ ) {
+
+ require YAML ;
+
+ eval {
+ @load_vals = YAML::Load( $text ) ;
+ } ;
+
+ return "Load error in file '$file_name' with YAML: $@" if $@ ;
+
+# lose the outer anon array wrapper and return the values
+
+ return $load_vals[0] ;
+ }
+
+ @load_vals = eval "($text)" ;
+
+ return "Load error in file '$file_name' with eval: $@" if $@ ;
+ return \@load_vals ;
+}
+
+
+=head2 write_file
+
+write_sub is a utility sub to write a file. It takes a file
+name and a list of strings. It opens the file and writes
+all data passed into the file. This will overwrite any data
+in the file.
+
+=cut
+
+# utility sub to write a file. takes a file name and a list of strings
+
+sub write_file {
+
+ my( $file_name ) = shift ;
+
+ local( *FH ) ;
+
+ open( FH, ">$file_name" ) || carp "can't create $file_name $!" ;
+
+ print FH @_ ;
+}
+
+1 ;
--- /dev/null
+# File: Stem/Vars.pm
+
+# This file is part of Stem.
+# Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
+
+# Stem is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# Stem is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with Stem; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# For a license to use the Stem under conditions other than those
+# described here, to purchase support for this software, or to purchase a
+# commercial warranty contract, please contact Stem Systems at:
+
+# Stem Systems, Inc. 781-643-7504
+# 79 Everett St. info@stemsystems.com
+# Arlington, MA 02474
+# USA
+
+package Stem::Vars ;
+
+use strict ;
+use Stem::Route ;
+use base 'Exporter' ;
+use vars qw( %Env @EXPORT ) ;
+
+@EXPORT = qw( %Env ) ;
+
+
+
+Stem::Route::register_class( __PACKAGE__, 'var', 'env' ) ;
+
+sub new {
+
+ my( $class, %env ) = @_ ;
+
+ delete $env{ 'reg_name' } ;
+
+ @Env{ keys %env } = values %env ;
+
+ return ;
+}
+
+sub set_env_cmd {
+
+ my( $self, $msg ) = @_ ;
+
+ my( $data ) = $msg->data() ;
+
+ $data = ${$data} if ref $data ;
+
+ if ( my( $key, $val ) = $data =~ /^\s*(\w+)\s*=\s*(.+)$/ ) {
+
+ $val =~ s/\s+$// ;
+ $Env{ $key } = $val ;
+ }
+
+ return ;
+}
+
+sub get_env_cmd {
+
+ my( $self, $msg ) = @_ ;
+
+ my( $data ) = $msg->data() ;
+
+ $data = ${$data} if ref $data ;
+
+ return $Env{$data} ;
+}
+
+sub status_cmd {
+
+ my $text ;
+
+ $text = <<TEXT ;
+
+Status of Stem Environment
+
+TEXT
+
+ foreach my $key ( sort keys %Env ) {
+
+ my $val = $Env{$key} ;
+
+ $text .= sprintf( "\t%-24s = '$val'\n", $key ) ;
+ }
+
+ $text .= "\n\n" ;
+
+ return $text ;
+}
+
+1 ;
--- /dev/null
+# File: Stem/WorkQueue.pm
+
+# This file is part of Stem.
+# Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
+
+# Stem is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+
+# Stem is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with Stem; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+# For a license to use the Stem under conditions other than those
+# described here, to purchase support for this software, or to purchase a
+# commercial warranty contract, please contact Stem Systems at:
+
+# Stem Systems, Inc. 781-643-7504
+# 79 Everett St. info@stemsystems.com
+# Arlington, MA 02474
+# USA
+
+package Stem::WorkQueue ;
+
+use strict ;
+
+my $attr_spec = [
+
+] ;
+
+
+###########
+# This POD section is autoegenerated. Any edits to it will be lost.
+
+=head2 Constructor Attributes for Class Stem::WorkQueue
+
+=over 4
+
+
+=back
+
+=cut
+
+# End of autogenerated POD
+###########
+
+
+
+sub new {
+
+ my( $class ) = shift ;
+
+ my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
+ return $self unless ref $self ;
+
+ $self->{ 'work_queue' } = [] ;
+ $self->{ 'worker_queue' } = [] ;
+
+ return $self ;
+}
+
+sub msg_in {
+
+ my ( $self, $msg ) = @_ ;
+
+ push( @{$self->{ 'work_queue' }}, $msg ) ;
+
+ $self->_check_for_work() ;
+
+ return ;
+}
+
+sub worker_in {
+
+ my ( $self, $msg ) = @_ ;
+
+#print $msg->dump('worker') ;
+
+ push( @{$self->{ 'worker_queue' }}, $msg ) ;
+
+ $self->_check_for_work() ;
+
+ return ;
+}
+
+sub _check_for_work {
+
+ my ( $self ) = @_ ;
+
+ my $work_q = $self->{ 'work_queue' } ;
+ my $worker_q = $self->{ 'worker_queue' } ;
+
+ while( 1 ) {
+
+# see if we have both workers and work to do
+
+ return unless @{$work_q} && @${worker_q} ;
+
+ my $work_msg = shift @{$work_q} ;
+ my $worker_msg = shift @{$worker_q} ;
+
+#print "WORK out [", Store( $worker_msg->from() ), "]\n" ;
+
+ $work_msg->to( scalar $worker_msg->from() ) ;
+
+#print $work_msg->dump( 'work' ) ;
+ $work_msg->dispatch() ;
+ }
+}
+
+sub status_cmd {
+
+ my ($self) = @_ ;
+
+ my $work_cnt = @{$self->{ 'work_queue' }} ;
+ my $worker_cnt = @{$self->{ 'worker_queue' }} ;
+
+ return <<STATUS ;
+
+Work Queue: $work_cnt
+Worker Queue: $worker_cnt
+
+STATUS
+
+}
+
+1;
--- /dev/null
+#!/usr/local/bin/perl -w
+
+use strict ;
+use lib '../lib' ;
+
+use Stem::Event ;
+use Stem::Socket ;
+use Stem::AsyncIO ;
+
+use Time::HiRes qw( time ) ;
+use Getopt::Long ;
+
+my $opts_ok = GetOptions(
+ \my %opts,
+ 'upper_port=s',
+ 'reverse_port=s',
+ 'v|verbose',
+ 'help|h',
+) ;
+
+usage() unless $opts_ok ;
+usage() if $opts{help} ;
+
+
+my $time ;
+
+# this table defines the servers. each entry has the default port
+# number and the code to execute on the input data.
+
+my %servers = (
+
+ upper => {
+
+ port => 8888,
+ code => sub { uc $_[0] },
+ },
+
+ reverse => {
+
+ port => 8889,
+ code => sub { scalar( reverse $_[0] ) },
+ },
+) ;
+
+start_servers() ;
+
+Stem::Event::start_loop() ;
+
+exit ;
+
+sub start_servers {
+
+ while( my( $id, $server ) = each %servers ) {
+
+# make each server entry an object
+
+ bless $server, __PACKAGE__ ;
+
+# save its id in itself
+
+ $server->{id} = $id ;
+
+# get the port from the options or the default
+
+ my $port = $opts{"${id}_port"} || $server->{port} ;
+
+# get the listen socket and save it
+
+ my $listen = Stem::Socket->new(
+ object => $server,
+ port => $port,
+ server => 1,
+ ) ;
+
+ die "can't listen on $port: $listen" unless ref $listen ;
+
+ $server->{listen} = $listen ;
+ }
+}
+
+# this is called when a socket is connected
+
+sub connected {
+
+ my( $server, $socket ) = @_ ;
+
+# create a session object. blessed directly into this class because it
+# is simple and works nicely
+
+ my $self = bless {
+
+ socket => $socket,
+ id => $server->{id},
+ }, __PACKAGE__ ;
+
+# get an asyncio object and save it in the session object
+# this will buffer all input and send it only when the socket is closed
+
+ my $async = Stem::AsyncIO->new(
+ object => $self,
+ fh => $socket,
+ send_data_on_close => 1,
+ ) ;
+ ref $async or die "can't create Async: $async" ;
+ $self->{async} = $async ;
+}
+
+# this is called when we have read data
+
+sub async_read_data {
+
+ my( $self, $data ) = @_ ;
+
+# print "READ [$$data]\n" ;
+
+# save (the ref to) the data
+
+ $self->{'data'} = $data ;
+
+# get a random delay time
+
+# my $delay = .5 ;
+ my $delay = rand( 1 ) + .5 ;
+ $delay = .01 ;
+
+#print "DELAY $delay\n" ;
+$time = time() ;
+
+# get and save a timer object with this delay
+
+ my $timer = Stem::Event::Timer->new(
+ object => $self,
+ delay => $delay,
+ ) ;
+ ref $timer or die "can't create Timer: $timer" ;
+ $self->{timer} = $timer ;
+
+ return ;
+}
+
+# timeout is over so this gets called
+
+sub timed_out {
+
+ my( $self ) = @_ ;
+
+# my $delta = time() - $time ;
+# printf "DELTA = %6f\n", $delta ;
+
+# get the real datat
+ my $data = ${$self->{data}};
+
+# find the server (we could have saved this in the session object but
+# we can do this quick lookup to get it)
+
+ my $server = $servers{ $self->{'id'} } ;
+
+# process the input data with the code in the server object
+
+ my $echo_data = $server->{code}->( $data ) ;
+
+# print "ECHO [$echo_data]\n" ;
+
+# write out the echo data to the socket and close it when done.
+
+ $self->{async}->final_write( $echo_data ) ;
+}
+
+sub usage {
+
+ my ( $error ) = @_ ;
+
+ $error ||= '' ;
+ die <<DIE ;
+$error
+usage: $0 [--help|h] [--upper_port <port>] [--reverse_port <port>]
+
+
+ upper_port <port> Set the port for the upper case server
+ (default is 8888)
+ reverse_port <port> Set the port for the string reverse server
+ (default is 8889)
+ help | h Print this help text
+DIE
+
+}
+
+# sub async_closed {
+# my( $self ) = @_ ;
+# print "CLOSED $self\n" ;
+# }
+
+# DESTROY {
+# my( $self ) = @_ ;
+# print "DESTROY $self\n" ;
+# }
--- /dev/null
+#!/usr/local/bin/perl -w
+
+use strict ;
+use lib '../lib' ;
+
+BEGIN {
+# $Stem::Vars::Env{event_loop} = 'perl' ;
+}
+
+use Stem ;
+use Stem::Socket ;
+use Stem::AsyncIO ;
+
+use Getopt::Long ;
+
+my $opts_ok = GetOptions(
+ \my %opts,
+ 'port=s',
+ 'max_clients=i',
+ 'total_clients=i',
+ 'string_min_len=i',
+ 'string_max_len=i',
+ 'verbose|v',
+ 'help|h',
+) ;
+
+usage() unless $opts_ok ;
+usage() if $opts{help} ;
+
+# set defaults for various options
+
+$opts{max_clients} ||= 1 ;
+$opts{total_clients} ||= 1 ;
+$opts{port} ||= 8887 ;
+$opts{string_min_len} ||= 8 ;
+
+my $client_cnt = 0 ;
+
+my %clients ;
+
+make_clients() ;
+
+Stem::Event::start_loop() ;
+
+exit ;
+
+# this creates and saves the client sessions
+
+sub make_clients {
+
+# keep making new clients if we are under the total and the parallel counts
+
+ while( $client_cnt < $opts{total_clients} &&
+ keys %clients < $opts{max_clients} ) {
+
+# get a random token for our data
+
+ my $data = rand_string( $opts{string_min_len},
+ $opts{string_max_len},
+ ) ;
+
+ print "String [$data]\n" if $opts{verbose} ;
+
+# make the session object
+
+ my $self = bless {
+ data => $data,
+ }, __PACKAGE__ ;
+
+# create the connection object and save it
+
+ my $connect = Stem::Socket->new(
+ object => $self,
+ port => $opts{port},
+ ) ;
+ ref $connect or die "can't create Socket: $connect" ;
+ $self->{connect} = $connect ;
+
+# save the session object so we can track all the active ones
+
+ $clients{ $self } = $self ;
+
+# print "cnt $client_cnt max $max_clients num ", keys %clients, "\n" ;
+
+ $client_cnt++ ;
+ }
+}
+
+# this is called when we have connected to the middle layer server
+
+sub connected {
+
+ my( $self, $socket ) = @_ ;
+
+# save the connected socket
+
+ $self->{'socket'} = $socket ;
+
+# we don't need the connection object anymore
+
+ my $connect = delete $self->{connect} ;
+ $connect->shut_down() ;
+
+# create and save an async i/o object to do i/o with the middle layer server
+
+ my $async = Stem::AsyncIO->new(
+ object => $self,
+ fh => $socket,
+ send_data_on_close => 1,
+ ) ;
+ ref $async or die "can't create Async: $async" ;
+ $self->{async} = $async ;
+
+# write the data to the middle layer (and send no more data)
+
+ $async->final_write( \$self->{data} ) ;
+}
+
+# this is called when we have read all the data from the middle layer
+
+sub async_read_data {
+
+ my( $self, $data ) = @_ ;
+
+ print "Read [${$data}]\n" if $opts{verbose} ;
+
+# we don't need the async i/o object anymore
+
+ my $async = delete $self->{async} ;
+ $async->shut_down() ;
+
+# make the string that we expect back from the middle layer
+
+ my $expected = uc( $self->{data} ) . reverse( $self->{data} ) ;
+
+ print "Expected [$expected]\n" if $opts{verbose} ;
+
+# check and report the results
+ if ( ${$data} ne $expected ) {
+
+ print "ERROR\n" if $opts{verbose} ;
+ }
+ else {
+ print "OK\n" if $opts{verbose} ;
+ }
+
+# delete this client session as we are done
+
+ delete( $clients{ $self } ) ;
+
+# replace this session with a new one (if we haven't hit the max yet)
+
+ make_clients() ;
+}
+
+INIT {
+
+my @alpha = ( 'a' .. 'z', '0' .. '9' ) ;
+
+sub rand_string {
+
+ my( $min_len, $max_len ) = @_ ;
+
+ $min_len ||= 8 ;
+ $max_len ||= $min_len ;
+
+
+ my $length = $min_len + int rand( $max_len - $min_len + 1 ) ;
+
+ return join '', map $alpha[rand @alpha], 1 .. $length ;
+}
+
+}
+
+sub usage {
+
+ my ( $error ) = @_ ;
+
+ $error ||= '' ;
+ die <<DIE ;
+$error
+usage: $0 [--help|h] [--verbose|v] [--port <port>]
+ [--total_clients <count>] [--max_clients <count>]
+ [--string_min_len <len>] [--max_clients <count>]
+
+ port <port> Set the port for the middle layer server
+ (default is 8887)
+ max_clients <count> Set the maximum number of parallel clients
+ (default is 1)
+ total_clients <count> Set the total number of clients to run
+ (default is 1)
+ string_min_len <len> Set the minimum length for the random strings
+ (default is 8)
+ string_max_len <len> Set the maximum length for the random strings
+ (default is string_min_len which means a fixed
+ length string)
+ help | h Print this help text
+DIE
+
+}
--- /dev/null
+#!/usr/local/bin/perl -w
+
+use strict ;
+use lib '../lib' ;
+
+BEGIN {
+ $Stem::Vars::Env{event_loop} = 'perl' ;
+}
+
+
+use Stem::Event ;
+use Stem::Socket ;
+use Stem::AsyncIO ;
+
+use Data::Dumper ;
+use Getopt::Long ;
+
+my $opts_ok = GetOptions(
+ \my %opts,
+ 'server_port=s',
+ 'upper_port=s',
+ 'reverse_port=s',
+ 'verbose|v',
+ 'help|h',
+) ;
+
+usage() unless $opts_ok ;
+usage() if $opts{help} ;
+
+my %backend_ports = (
+
+ 'reverse' => $opts{reverse_port} || 8888,
+ 'upper' => $opts{upper_port} || 8889,
+) ;
+
+# this controls the order of requests to the backends.
+
+my @backend_ids = sort keys %backend_ports ;
+
+my $listen = init_server( $opts{server_port} || 8887 ) ;
+
+Stem::Event::start_loop() ;
+
+exit ;
+
+# create the listen socket for the server side of the middle layer.
+
+sub init_server {
+
+ my( $port ) = @_ ;
+
+# create the middle layer listen socket
+
+ my $listen = Stem::Socket->new(
+ object => bless( {
+ }, __PACKAGE__),
+ method => 'client_connected',
+ port => $port,
+ server => 1,
+ ) ;
+
+ die "can't listen on $port: $listen" unless ref $listen ;
+
+ return $listen ;
+}
+
+# this is called when the server has accepted a socket connection
+
+sub client_connected {
+
+ my( $obj, $socket ) = @_ ;
+
+# create the session object
+
+ my $self = bless {}, __PACKAGE__ ;
+
+# create and save the async io object for the client
+
+ my $async = Stem::AsyncIO->new(
+ object => $self,
+ fh => $socket,
+ read_method => 'client_read_data',
+ send_data_on_close => 1,
+ ) ;
+ ref $async or die "can't create Async: $async" ;
+ $self->{client_async} = $async ;
+
+# store a copy of the backend as we shift them out
+
+ $self->{backend_ids} = [ @backend_ids ] ;
+
+}
+
+# this is called when all the data from client has been read.
+
+sub client_read_data {
+
+ my( $self, $data ) = @_ ;
+
+ print "Client read [${$data}]\n" if $opts{verbose} ;
+
+# store the client data (a ref is passed in)
+
+ $self->{'client_data'} = ${$data} ;
+
+# connect to the first backend server
+
+ my $backend_id = shift( @{$self->{backend_ids}} ) ;
+
+ $self->connect_to_backend( $backend_id ) ;
+}
+
+# this connects the session to one of the backends
+
+sub connect_to_backend {
+
+ my( $self, $id ) = @_ ;
+
+# connect to the backend with this id and its port and save the
+# connect object
+
+ my $connect = Stem::Socket->new(
+ object => $self,
+ id => $id,
+ port => $backend_ports{ $id },
+ method => 'backend_connected',
+ ) ;
+
+ ref $connect or die "can't create Socket: $connect" ;
+ $self->{connect}{$id} = $connect ;
+}
+
+# this is called when a backend end connection succeeds
+
+sub backend_connected {
+
+ my( $self, $socket, $id ) = @_ ;
+
+# delete and shutdown the connect object as we no longer need it
+
+ my $connect = delete $self->{connect}{$id} ;
+ $connect->shut_down() ;
+
+# create and save an async i/o object for this backend
+
+ my $async = Stem::AsyncIO->new(
+ object => $self,
+ id => $id,
+ fh => $socket,
+ read_method => 'backend_read_data',
+ send_data_on_close => 1,
+ ) ;
+ ref $async or die "can't create Async: $async" ;
+ $self->{async}{$id} = $async ;
+
+# write the client data to the back end. no more data will follow.
+
+ $async->final_write( \$self->{client_data} ) ;
+}
+
+# this is called when we have read all the data from the backend
+
+sub backend_read_data {
+
+ my( $self, $data, $id ) = @_ ;
+
+ print "Backend $id READ [${$data}]\n" if $opts{verbose} ;
+
+# save the backend data (we are passed a ref)
+
+ $self->{backend_data}{$id} = ${$data} ;
+
+# delete and shutdown the async i/o for the backend since we don't
+# need it anymore
+
+ my $async = delete $self->{async}{$id} ;
+ $async->shut_down() ;
+
+# do the next backend in the list. this is a simple way to handle
+# sequential backends we use the backend_ids array in the session
+# object to track which backends we have not used yet.
+
+ if ( my $backend_id = shift( @{$self->{backend_ids}} ) ) {
+
+# connect to the next backend server.
+
+ $self->connect_to_backend( $backend_id ) ;
+ return ;
+ }
+
+# no more backends so we return the joined backend data to the client.
+
+# delete the async so we don't keep a ref to it around. this will
+# allow for self cleanup when it is done with the final write to the
+# client.
+
+ $async = delete $self->{client_async} ;
+ $async->final_write(
+ join( '', @{$self->{backend_data}}{ @backend_ids } )
+ ) ;
+}
+
+sub usage {
+
+ my ( $error ) = @_ ;
+
+ $error ||= '' ;
+ die <<DIE ;
+$error
+usage: $0 [--help|h] [--upper_port <port>] [--reverse_port <port>]
+ [--server_port <port>] [--v|--verbose]
+
+ upper_port <port> Set the port for the middleware server
+ (default is 8888)
+ upper_port <port> Set the port for the upper case server
+ (default is 8888)
+ reverse_port <port> Set the port for the string reverse server
+ (default is 8889)
+ verbose Set verbose mode
+ help | h Print this help text
+DIE
+
+}
+
+# this destroy can be uncommented to see the actual destruction of the
+# various obects in this script.
+
+# DESTROY {
+# my( $self ) = @_ ;
+# print "DEST [$self]\n" ;
+# }
--- /dev/null
+#!/usr/local/bin/perl -w
+
+use strict ;
+
+use Stem::Event ;
+use Stem::Socket ;
+use Stem::AsyncIO ;
+use Stem::Gather ;
+
+use Data::Dumper ;
+use Getopt::Long ;
+
+my $opts_ok = GetOptions(
+ \my %opts,
+ 'server_port=s',
+ 'upper_port=s',
+ 'reverse_port=s',
+ 'verbose|v',
+ 'help|h',
+) ;
+
+usage() unless $opts_ok ;
+usage() if $opts{help} ;
+
+my %backend_ports = (
+
+ 'reverse' => $opts{reverse_port} || 8888,
+ 'upper' => $opts{upper_port} || 8889,
+) ;
+
+# this controls the order of requests to the backends.
+
+my @backend_ids = sort keys %backend_ports ;
+
+my $listen = init_server( $opts{server_port} || 8887 ) ;
+
+Stem::Event::start_loop() ;
+
+exit ;
+
+# create the listen socket for the server side of the middle layer.
+
+sub init_server {
+
+ my( $port ) = @_ ;
+
+# create the middle layer listen socket
+
+ my $listen = Stem::Socket->new(
+ object => bless( {
+ }, __PACKAGE__),
+ method => 'client_connected',
+ port => $port,
+ server => 1,
+ ) ;
+
+ die "can't listen on $port: $listen" unless ref $listen ;
+
+ return $listen ;
+}
+
+# this is called when the server has accepted a socket connection
+
+sub client_connected {
+
+ my( $obj, $socket ) = @_ ;
+
+# create the session object
+
+ my $self = bless {}, __PACKAGE__ ;
+
+# create and save the async io object for the client
+
+ my $async = Stem::AsyncIO->new(
+ object => $self,
+ fh => $socket,
+ read_method => 'client_read_data',
+ send_data_on_close => 1,
+ ) ;
+ ref $async or die "can't create Async: $async" ;
+ $self->{client_async} = $async ;
+
+# create and save the gather object
+
+ my $gather = Stem::Gather->new(
+ object => $self,
+ keys => \@backend_ids,
+ ) ;
+
+ ref $gather or die "can't create Gather: $gather" ;
+ $self->{gather} = $gather ;
+}
+
+# this is called when all the data from client has been read.
+
+sub client_read_data {
+
+ my( $self, $data ) = @_ ;
+
+ print "Client read [${$data}]\n" if $opts{verbose} ;
+
+# store the client data (a ref is passed in)
+
+ $self->{'client_data'} = ${$data} ;
+
+# connect to all of the backend servers
+
+ $self->connect_to_backends() ;
+}
+
+# this connects the session to all of the backends
+
+sub connect_to_backends {
+
+ my( $self ) = @_ ;
+
+# loop over all the backends
+
+ foreach my $id ( @backend_ids ) {
+
+# connect to the backend with this id and its port and save the
+# connect object
+
+ my $connect = Stem::Socket->new(
+ object => $self,
+ id => $id,
+ port => $backend_ports{ $id },
+ method => 'backend_connected',
+ ) ;
+
+ ref $connect or die "can't create Socket: $connect" ;
+ $self->{connect}{$id} = $connect ;
+ }
+}
+
+# this is called when a backend end connection succeeds
+
+sub backend_connected {
+
+ my( $self, $socket, $id ) = @_ ;
+
+# delete and shutdown the connect object as we no longer need it
+
+ my $connect = delete $self->{connect}{$id} ;
+ $connect->shut_down() ;
+
+# create and save an async i/o object for this backend
+
+ my $async = Stem::AsyncIO->new(
+ object => $self,
+ id => $id,
+ fh => $socket,
+ read_method => 'backend_read_data',
+ send_data_on_close => 1,
+ ) ;
+ ref $async or die "can't create Async: $async" ;
+ $self->{async}{$id} = $async ;
+
+# write the client data to the back end. no more data will follow.
+
+ $async->final_write( \$self->{client_data} ) ;
+}
+
+# this is called when we have read all the data from the backend
+
+sub backend_read_data {
+
+ my( $self, $data, $id ) = @_ ;
+
+ print "Backend $id READ [${$data}]\n" if $opts{verbose} ;
+
+# save the backend data (we are passed a ref)
+
+ $self->{backend_data}{$id} = ${$data} ;
+
+# delete and shutdown the async i/o for the backend since we don't
+# need it anymore
+
+ my $async = delete $self->{async}{$id} ;
+ $async->shut_down() ;
+
+# mark that this backend is done
+
+ $self->{'gather'}->gathered( $id ) ;
+}
+
+# this is called when all the backends are done.
+
+sub gather_done {
+
+ my( $self ) = @_ ;
+
+ my $gather = delete $self->{gather} ;
+ $gather->shut_down() ;
+
+# no more backends so we return the joined backend data to the client.
+
+# we don't need the gather object around anymore
+# allow for self cleanup when it is done with the final write to the
+# client.
+
+ my $async = delete $self->{client_async} ;
+ $async->final_write(
+ join( '', @{$self->{backend_data}}{ @backend_ids } )
+ ) ;
+}
+
+
+
+sub usage {
+
+ my ( $error ) = @_ ;
+
+ $error ||= '' ;
+ die <<DIE ;
+$error
+usage: $0 [--help|h] [--upper_port <port>] [--reverse_port <port>]
+ [--server_port <port>] [--v|--verbose]
+
+ upper_port <port> Set the port for the middleware server
+ (default is 8888)
+ upper_port <port> Set the port for the upper case server
+ (default is 8888)
+ reverse_port <port> Set the port for the string reverse server
+ (default is 8889)
+ verbose Set verbose mode
+ help | h Print this help text
+DIE
+
+}
+
+# this destroy can be uncommented to see the actual destruction of the
+# various obects in this script.
+
+# DESTROY {
+# my( $self ) = @_ ;
+# print "DEST [$self]\n" ;
+# }
--- /dev/null
+
+unless ( eval { require Parse::RecDescent } ) {
+
+ print "1..0 # Skip Parse::RecDescent is not installed\n" ;
+ exit ;
+}
+
+exec qw( run_stem event_loop=perl test_flow) ;
--- /dev/null
+use lib 't/event' ;
+
+unless ( eval { require Event } ) {
+
+ print "1..0 # Skip Event.pm is not installed\n" ;
+ exit ;
+}
+
+@ARGV = 'event' ;
+require 'event_test.pl' ;
--- /dev/null
+#!/usr/local/bin/perl -w
+
+BEGIN {
+ $Stem::Vars::Env{ 'event_loop' } = shift ;
+
+ unless ( eval { require Time::HiRes } ) {
+
+ Time::HiRes->import( qw( time ) ) ;
+ }
+}
+
+use strict ;
+
+#use Test::More tests => 29 ;
+use Test::More tests => 24 ;
+
+use Symbol ;
+
+use Stem::Event ;
+use Stem::Class ;
+
+my $self = bless {} ;
+
+test_events() ;
+
+exit ;
+
+sub test_events {
+
+# test_null_events() ;
+# test_plain_events () ;
+# test_signal_events () ;
+ test_hard_timer_events () ;
+ test_soft_timer_events () ;
+ test_io_events () ;
+}
+
+sub test_null_events {
+
+ local $SIG{__WARN__} = sub{} if
+ $Stem::Vars::Env{ 'event_loop' } eq 'event' ;
+
+ Stem::Event::start_loop() ;
+
+ ok( 1, 'null - event loop exit' ) ;
+}
+
+sub test_plain_events {
+
+ my $event = Stem::Event::Plain->new(
+ 'object' => $self
+ ) ;
+
+ ok( ref $event, 'plain event created' ) ;
+
+ Stem::Event::start_loop() ;
+
+ ok( 1, 'plain - event loop exit' ) ;
+}
+
+# callback method for plain
+
+sub triggered {
+
+ my( $self ) = @_ ;
+
+ ok( 1, 'plain event triggered' ) ;
+}
+
+sub test_signal_events {
+
+ SKIP: {
+ if ( $^O =~ /win32/i ) {
+
+ skip( "signals not supported on windows", 3 ) ;
+ return ;
+ }
+
+ my $event = Stem::Event::Signal->new(
+ 'object' => $self,
+ 'signal' => 'INT',
+ ) ;
+
+ ok( ref $event, 'signal event created' ) ;
+
+ $self->{'sig_event'} = $event ;
+
+ kill 'INT', $$ ;
+
+#print "kill INT\n" ;
+
+ Stem::Event::start_loop() ;
+
+ ok( 1, 'signal - event loop exit' ) ;
+ }
+}
+
+# callback method for signal
+
+sub sig_int_handler {
+
+ my( $self ) = @_ ;
+
+ ok( 1, 'signal event triggered' ) ;
+
+ $self->{'sig_event'}->cancel() ;
+ Stem::Event::stop_loop() ;
+}
+
+
+use constant INTERVAL => 4 ;
+use constant SLEEP => 2 ;
+use constant TIMER_CNT => 2 ;
+
+# hard timeouts are timed from the beginning of the callback. so accumulated
+# time in the callback doesn't affect the next callback.
+
+sub test_hard_timer_events {
+
+ my $event = Stem::Event::Timer->new(
+ 'object' => $self,
+ 'method' => 'hard_timeout',
+ 'interval' => INTERVAL,
+ 'delay' => INTERVAL, # REMOVE - only for .10
+ 'repeat' => 1,
+ 'hard' => 1,
+ ) ;
+
+ ok( ref $event, 'hard timer event created' ) ;
+ print "$event\n" unless ref $event ;
+
+ $self->{'hard_timer_event'} = $event ;
+ $self->{'hard_timer_count'} = TIMER_CNT ;
+ $self->{'hard_timer_start_time'} = time ;
+
+ Stem::Event::start_loop() ;
+
+ ok( 1, 'hard timer - event loop exit' ) ;
+}
+
+sub hard_timeout {
+
+ my( $self ) = @_ ;
+
+ ok( 1, 'hard timer event triggered' ) ;
+
+ if ( --$self->{'hard_timer_count'} > 0 ) {
+
+ my $time = time ;
+ my $delta = $time - $self->{'hard_timer_start_time'} ;
+ $self->{'hard_timer_start_time'} = $time ;
+
+ ok( $delta >= INTERVAL, 'hard delta' ) ;
+
+ hard_sleep( SLEEP ) ;
+
+ return ;
+ }
+
+
+ my $time = time ;
+ my $delta = $time - $self->{'hard_timer_start_time'} ;
+
+#print "O $self->{'hard_timer_start_time'} T $time D $delta I ", INTERVAL, "\n" ;
+
+ ok( $delta >= INTERVAL, 'hard delta 2' ) ;
+ ok( $delta <= INTERVAL + SLEEP, 'hard delta sleep' ) ;
+
+ $self->{'hard_timer_event'}->cancel() ;
+
+ Stem::Event::stop_loop() ;
+}
+
+
+# Soft timeouts are timed from the end of the callback. so accumulated
+# time in the callback delays the next callback.
+
+sub test_soft_timer_events {
+
+ my $event = Stem::Event::Timer->new(
+ 'object' => $self,
+ 'method' => 'soft_timeout',
+ 'interval' => INTERVAL,
+ 'delay' => INTERVAL, # REMOVE - only for .10
+ 'repeat' => 1,
+ ) ;
+
+ ok( ref $event, 'soft timer event created' ) ;
+# print "$event\n" unless ref $event ;
+
+ $self->{'soft_timer_event'} = $event ;
+ $self->{'soft_timer_count'} = TIMER_CNT ;
+ $self->{'soft_timer_start_time'} = time ;
+
+#print "OTIME $self->{'soft_timer_start_time'}\n" ;
+
+ Stem::Event::start_loop() ;
+
+ ok( 1, 'soft timer - event loop exit' ) ;
+}
+
+sub soft_timeout {
+
+ my( $self ) = @_ ;
+
+ ok( 1, 'soft timer event triggered' ) ;
+
+ if ( --$self->{'soft_timer_count'} > 0 ) {
+
+ my $time = time ;
+ my $delta = $time - $self->{'soft_timer_start_time'} ;
+
+#print "T $time D $delta I ", INTERVAL, "\n" ;
+
+ ok( $delta >= INTERVAL, 'soft delta' ) ;
+
+ hard_sleep( SLEEP ) ;
+
+#my $curr_time = time() ;
+#print "DONE $curr_time\n" ;
+
+ return ;
+ }
+
+ my $time = time ;
+ my $delta = $time - $self->{'soft_timer_start_time'} ;
+
+#print "TIME2 $time OTIME $self->{'soft_timer_start_time'} DEL $delta INTERVAL ", INTERVAL, "\n" ;
+
+# ok( $delta >= INTERVAL, 'soft delta 2' ) ;
+ ok( $delta >= INTERVAL + SLEEP, 'soft delta 3' ) ;
+
+ $self->{'soft_timer_event'}->cancel() ;
+
+ Stem::Event::stop_loop() ;
+}
+
+sub test_io_events {
+
+ Stem::Event::init_loop() ;
+
+ my $read_fh = gensym ;
+ my $write_fh = gensym ;
+
+# get a pipe to read/write through.
+
+ use Socket;
+ socketpair( $read_fh, $write_fh, AF_UNIX, SOCK_STREAM, PF_UNSPEC ) ;
+
+ $self->{read_fh} = $read_fh ;
+ $self->{write_fh} = $write_fh ;
+ $self->{message} = 'Stem Read/Write Event' ;
+
+ # create the read and write events
+
+ my $read_event = Stem::Event::Read->new(
+ 'object' => $self,
+ 'fh' => $read_fh,
+ 'timeout' => 3,
+ ) ;
+
+ ok( ref $read_event, 'read event created' ) ;
+ $self->{'read_event'} = $read_event ;
+
+ my $write_event = Stem::Event::Write->new(
+ 'object' => $self,
+ 'fh' => $write_fh,
+ ) ;
+
+ ok( ref $write_event, 'write event created' ) ;
+ $self->{'write_event'} = $write_event ;
+
+ Stem::Event::start_loop() ;
+
+ ok( 1, 'io - event loop exit' ) ;
+}
+
+sub read_timeout {
+
+ my( $self ) = @_ ;
+
+ ok( 1, 'read event timed out' ) ;
+
+ $self->{'write_event'}->start() ;
+}
+
+
+sub writeable {
+
+ my( $self ) = @_ ;
+
+ ok( 1, 'write event triggered' ) ;
+
+ syswrite( $self->{'write_fh'}, $self->{'message'} ) ;
+
+ $self->{'write_event'}->cancel() ;
+}
+
+sub readable {
+
+ my( $self ) = @_ ;
+
+ ok(1, 'read event triggered' ) ;
+
+ my( $read_buf ) ;
+
+ my $bytes_read = sysread( $self->{'read_fh'}, $read_buf, 1000 ) ;
+
+ ok( $bytes_read, 'read byte count' ) ;
+
+ is( $read_buf, $self->{'message'}, 'read event compare' ) ;
+
+ $self->{'read_event'}->cancel() ;
+
+ Stem::Event::stop_loop() ;
+}
+
+# do a real hard sleep without alarm signal as that can screw up the tests
+# sleep time is in (float) seconds
+
+sub hard_sleep {
+
+ my( $sleep_time ) = @_ ;
+
+#print "BEFORE TIME $sleep_time\n" ;
+ while( $sleep_time > 0 ) {
+
+ my $curr_time = time() ;
+ select( undef, undef, undef, $sleep_time ) ;
+
+ $sleep_time -= time() - $curr_time ;
+
+#print "AFTER TIME $sleep_time\n" ;
+ }
+}
+
+1 ;
--- /dev/null
+use lib 't/event' ;
+
+unless ( eval { require Gtk } ) {
+
+ print "1..0 # Skip Gtk is not installed\n" ;
+ exit ;
+}
+
+print "1..0 # Skip Gtk is not supported yet\n" ;
+exit ;
+
+@ARGV = 'gtk' ;
+require 'event_test.pl' ;
--- /dev/null
+use lib 't/event' ;
+
+@ARGV = 'perl' ;
+require 'event_test.pl' ;
--- /dev/null
+use lib 't/event' ;
+
+unless ( eval { require POE } ) {
+
+ print "1..0 # Skip POE is not installed\n" ;
+ exit ;
+}
+
+print "1..0 # Skip POE is not supported yet\n" ;
+exit ;
+
+@ARGV = 'poe' ;
+require 'event_test.pl' ;
--- /dev/null
+use lib 't/event' ;
+
+unless ( eval { require Qt } ) {
+
+ print "1..0 # Skip Qt is not installed\n" ;
+ exit ;
+}
+
+print "1..0 # Skip Qt is not supported yet\n" ;
+exit ;
+
+@ARGV = 'qt' ;
+require 'event_test.pl' ;
--- /dev/null
+use lib 't/event' ;
+
+unless ( eval { require Stem::Event::Tk } ) {
+
+ print "1..0 # Skip Tk is not installed\n" ;
+ exit ;
+}
+
+@ARGV = 'tk' ;
+eval{ require 'event_test.pl' } ;
+#print "ERR [$@]\n" if $@ ;
\ No newline at end of file
--- /dev/null
+use lib 't/event' ;
+
+unless ( eval { require Wx } ) {
+
+ print "1..0 # Skip WxWindows is not installed\n" ;
+ exit ;
+}
+
+@ARGV = 'wx' ;
+require 'event_test.pl' ;
--- /dev/null
+
+unless ( eval { require Parse::RecDescent } ) {
+
+ print "1..0 # Skip Parse::RecDescent is not installed\n" ;
+ exit ;
+}
+
+print "\n$_ = $ENV{ $_ }\n" for qw( PATH PERL5LIB STEM_CONF_PATH ) ;
+
+exec 'run_stem test_packet_io' ;
--- /dev/null
+# t/socket/SockFork.pm
+# common code for forked socket tests
+
+package SockFork ;
+
+use strict ;
+
+
+use Stem ;
+use Stem::Socket ;
+
+use Test::More tests => 7 ;
+
+my $self = bless {} ;
+my $pid ;
+my $port = 9000 ;
+my $data = "FOO\n" ;
+
+sub test {
+
+ my ( $ssl_client_args, $ssl_server_args ) = @_ ;
+
+ my ( @ssl_client_args, @ssl_server_args ) ;
+
+ if ( @{$ssl_client_args} ) {
+
+ @ssl_client_args = ( 'ssl_args' => $ssl_client_args ) ;
+ @ssl_server_args = ( 'ssl_args' => $ssl_server_args ) ;
+ }
+
+
+ if ( $pid = fork() ) {
+
+ sleep 1 ;
+
+ $self->{'pid'} = $pid ;
+
+ ok( 1, 'parent' ) ;
+
+#print "SSL @ssl_client_args\n" ;
+
+ my $connect_sock = Stem::Socket->new(
+ 'object' => $self,
+ 'port' => $port,
+ @ssl_client_args,
+
+ ) ;
+
+ die $connect_sock unless ref $connect_sock ;
+
+ ok( 1, 'created connect event' ) ;
+ $self->{'connect_sock'} = $connect_sock ;
+ }
+ else {
+
+ my $listen_sock = Stem::Socket->new(
+ 'object' => $self,
+ 'port' => $port,
+ 'server' => 1,
+ 'method' => 'accepted',
+ @ssl_server_args
+ ) ;
+
+ die $listen_sock unless ref $listen_sock ;
+ $self->{'listen_sock'} = $listen_sock ;
+ }
+
+ Stem::Event::start_loop() ;
+
+ ok( 1, 'event loop exit' ) ;
+}
+
+sub connected {
+
+ my( $self, $client_sock ) = @_ ;
+
+#print "CLIENT [$client_sock]\n" ;
+
+ ok( 1, 'connected' ) ;
+
+ $self->{'client_sock'} = $client_sock ;
+
+ my $wcnt = $client_sock->syswrite( $data ) ;
+
+#print "WCNT [$wcnt] $!\n" ;
+
+ my $client_read_event = Stem::Event::Read->new(
+ 'object' => $self,
+ 'fh' => $client_sock,
+ 'method' => 'client_readable',
+ ) ;
+
+ ok( $client_read_event, 'created client read event' ) ;
+
+ $self->{'client_read_event'} = $client_read_event ;
+}
+
+sub client_readable {
+
+ my( $self ) = @_ ;
+
+ ok( 1, 'client readable' ) ;
+
+ my $buf ;
+
+ my $client_sock = $self->{'client_sock'} ;
+
+ my $cnt = $client_sock->sysread( $buf, 100 ) ;
+
+ is( $buf, "[$data]", 'client read data' ) ;
+
+#print "CLIENT READ $cnt [$buf]\n" ;
+
+ $self->{'connect_sock'}->shut_down() ;
+ $self->{'client_read_event'}->cancel() ;
+}
+
+sub accepted {
+
+ my( $self, $accepted_sock ) = @_ ;
+
+ $self->{'accepted_sock'} = $accepted_sock ;
+
+ $self->{'listen_sock'}->shut_down() ;
+
+ my $server_read_event = Stem::Event::Read->new(
+ 'object' => $self,
+ 'fh' => $accepted_sock,
+ 'method' => 'server_readable',
+ ) ;
+
+ $self->{'server_read_event'} = $server_read_event ;
+}
+
+sub server_readable {
+
+ my( $self ) = @_ ;
+
+ my $accepted_sock = $self->{'accepted_sock'} ;
+
+ my $cnt = $accepted_sock->sysread( my $buf, 100 ) ;
+
+ $accepted_sock->syswrite( "[$buf]" ) ;
+
+# exit forked child
+
+ exit ;
+}
+
+1 ;
--- /dev/null
+# t/socket/plain.t
+
+use strict ;
+
+use Stem ;
+use Stem::Socket ;
+
+use Test::More tests => 9 ;
+
+my $data = "FOO\n" ;
+
+test_socket() ;
+
+exit 0 ;
+
+sub test_socket {
+
+ my( $self, $accept_event, $connect_event ) ;
+
+ $self = bless {} ;
+
+ $accept_event = Stem::Socket->new(
+ 'object' => $self,
+ 'port' => 10_000,
+ 'server' => 1,
+ 'method' => 'accepted',
+ ) ;
+
+ die $accept_event unless ref $accept_event ;
+ $self->{'accept_event'} = $accept_event ;
+ ok( 1, 'listen' ) ;
+
+ $connect_event = Stem::Socket->new(
+ 'object' => $self,
+ 'port' => 10_000,
+ ) ;
+
+ die $connect_event unless ref $connect_event ;
+ $self->{'connect_event'} = $connect_event ;
+ ok( 1, 'connect' ) ;
+
+ Stem::Event::start_loop() ;
+
+ ok( 1, 'event loop exit' ) ;
+}
+
+sub accepted {
+
+ my( $self, $accepted_sock ) = @_ ;
+
+ ok( 1, 'accepted' ) ;
+
+ $self->{'accepted_sock'} = $accepted_sock ;
+
+ $self->{'accept_event'}->shut_down() ;
+
+ ok( 1, 'accept canceled' ) ;
+
+ my $read_event = Stem::Event::Read->new(
+ 'object' => $self,
+ 'fh' => $accepted_sock,
+ ) ;
+
+ $self->{'read_event'} = $read_event ;
+}
+
+sub readable {
+
+ my( $self ) = @_ ;
+
+ ok(1, 'read event triggered' ) ;
+
+ my $bytes_read = sysread( $self->{'accepted_sock'},
+ my $read_buf, 1000 ) ;
+
+ ok( $bytes_read, 'read byte count' ) ;
+
+ is( $read_buf, $data, 'read event compare' ) ;
+
+ close( $self->{'accepted_sock'} ) ;
+
+ $self->{'read_event'}->cancel() ;
+}
+
+sub connected {
+
+ my( $self, $connected_sock ) = @_ ;
+
+ ok( 1, 'connected' ) ;
+
+ my $wcnt = $connected_sock->syswrite( $data ) ;
+#print "SYSWR C $wcnt\n" ;
+
+ $self->{'connect_event'}->shut_down() ;
+}
--- /dev/null
+# t/socket/plain.t
+
+use lib 't/socket' ;
+
+use strict ;
+
+use SockFork ;
+
+my @ssl_client_args ;
+my @ssl_server_args ;
+
+SockFork::test( \@ssl_client_args, \@ssl_server_args ) ;
+
+exit 0 ;
--- /dev/null
+# t/socket/ssl.t
+
+use strict ;
+use lib 't/socket' ;
+
+unless ( eval { require IO::Socket::SSL } ) {
+
+ print "1..0 # Skip IO::Socket::SSL is not installed\n" ;
+ exit ;
+}
+
+
+require SockFork ;
+
+my @ssl_client_args = (
+ SSL_use_cert => 1,
+ SSL_verify_mode => 0x01,
+ SSL_passwd_cb => sub {return "bluebell"}
+) ;
+
+my @ssl_server_args = () ;
+
+SockFork::test( \@ssl_client_args, \@ssl_server_args ) ;
+
+exit 0 ;
--- /dev/null
+
+exec 'run_stem', 'test_udp' ;
projects / urisagit/Stem.git / commitdiff