--- /dev/null
+# Version control files and dirs.
+RCS
+CVS
+*,v$
+.svn/
+.git/
+
+# EUMM/MB generated files and dirs.
+MANIFEST.bak
+_build/
+Build
+Makefile
+blib/
+
+# Temp, old and emacs backup files.
+*~
+*.old
+old*
+\#*#
+.#*
+.*.swp
+lib-pod
+*.ok
+modules
+
+event_test
+*.gz
+dlug
+flow
+intel
+pod
+scaffidi
+slides
+stem2pod
+test
+
+
-use strict;
-use warnings ;
+#!/usr/bin/env perl
-use Config;
-use File::Spec;
+use strict ;
+use warnings ;
+use Config ;
+use File::Spec ;
use BuildStem ;
+use Data::Dumper ;
-my $is_win32 = ( $^O =~ /Win32/) ? 1 : 0 ;
+# I wonder if I should add the ability to put the Docs and Design etc
+# directories in apropriate spots, like
+# /usr/local/share/stem (site) or /usr/share/stem (vendor)
my %requires ;
my $version_from = File::Spec->catfile( File::Spec->curdir, 'lib', 'Stem.pm' );
my $build = BuildStem->new(
+#my $build = $class->new(
module_name => 'Stem',
dist_version_from => $version_from,
requires => \%requires,
+ dist_abstract => 'ABSTRACT GOES HERE',
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->is_unixish() || die "Stem currently only installs properly on *nix-like platforms.\n";
+
+### this will come in handy for some refactoring...
+## $build->config( 'install_base' )
+
+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
+
+print <<'EOT';
+
+Stem comes with a utility called 'run_stem' which takes care of things
+like initalizing Stem with a configuration file and controlling it's
+operation via various parameters you can pass in as environment
+variables or command line arguments.
+
+Stem configuration files are used to create and initialize Stem Cells
+(objects). run_stem can search a path list for config files, so you
+can set that list of directories here.
+
+Note that you can easily override this path 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 last directory in the list is where the standard and demo Stem
+configuration files will be installed.
+
+Please enter a list of directory paths separated by ':'.
+
+EOT
+
+my $conf_path = $build->prompt(
+ "What directories do you want Stem to search for configuration files?\n",
+ '.:~/.stem/conf:/usr/local/stem/conf'
+);
+$build->config_data(conf_path => $conf_path);
+
+
+
+
+
+
+=begin comment
+
+print "\n\nChecking to see if you have a good C compiler...\n\n" ;
+if ( $build->have_c_compiler() ) {
+ print <<'EOT';
+
+
+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.
+
+EOT
+ my $install_ssfe = $build->y_n("Do you want to install ssfe?\n", 'y');
+ $build->config_data(install_ssfe => $install_ssfe);
+ if ( $install_ssfe ) {
+
+ # Do horrible, nasty things.
+ # This really should be done with a proper makefile.
+
+ }
+}
+
+=cut
+
+
+
+
+
+print <<'EOT';
+
+Stem comes with a variety of demos to show how to get started and do some
+basic things.
+
+EOT
+my $install_demos = $build->y_n("\nDo you want to install the demos?\n",'n');
+$build->config_data( install_demos => $install_demos ) ;
+$build->config_data( build_demos => $install_demos ) ;
+if ( $install_demos ) {
+
+ my $demo_dir = $build->prompt(
+ "\nWhere do you want to install the demo scripts?\n",
+ '/usr/local/stem/demo'
+ );
+ $build->config_data(demo_dir => $demo_dir);
+ $build->install_path()->{demo} ||= $demo_dir;
+
+
+
+ my $demo_conf_dir = $build->prompt(
+ "\nWhere do you want to install the demo config files?\n",
+ '/usr/local/stem/conf'
+ );
+ $build->config_data(demo_conf_dir => $demo_conf_dir);
+ $build->install_path()->{conf} ||= $demo_conf_dir;
+ $build->add_build_element('conf');
+
+ my $cur_conf_path = $build->config_data('conf_path') ;
+ my $new_conf_path = $cur_conf_path =~ /(^|:)$demo_conf_dir(:|$)/ ?
+ $cur_conf_path : "$cur_conf_path:$demo_conf_dir" ;
+ $build->config_data( conf_path => $new_conf_path ) ;
+
+
+ # Check for telnet
+ my $telnet_path = $build->find_binary( 'telnet' ) || '' ;
+ while ( ! -x $telnet_path && ! $build->_is_unattended() ) {
+ print <<'EOT';
+
+
+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.
+
+EOT
+ $telnet_path = $build->prompt(
+ "Enter the path to telnet "
+ . "(or another compatible telnet client)",
+ '/usr/bin/telnet'
+ ) ;
+ }
+ $build->config_data( telnet_path => $telnet_path ) ;
+
+
+ # Check for xterm
+ my $xterm_path = $build->find_binary( 'xterm' ) || '' ;
+ while ( ! -x $xterm_path && ! $build->_is_unattended() ) {
+ print <<'EOT';
+
+
+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.
+
+EOT
+ $xterm_path = $build->prompt(
+ "Enter the path to xterm "
+ . "(or another compatible terminal emulator)",
+ '/usr/bin/xterm'
+ ) ;
+ }
+ $build->config_data( xterm_path => $xterm_path ) ;
+
+}
+
+
+
+my $script_dest = $build->install_destination('script') ;
+my $run_stem_path = File::Spec->catfile( $script_dest, 'run_stem' ) ;
+$build->config_data( run_stem_path => $run_stem_path ) ;
+
+
+
+
+my $bin_path = $build->install_destination('bin') ;
+$build->config_data( bin_path => $bin_path ) ;
+
+$build->config_data( perl_path => $build->config( 'perlpath' ) ) ;
+
+# Several different prefixes... which one to use??
+#$build->config_data( prefix => $build->prefix() ) ;
+$build->config_data( prefix => $build->config( 'install_base' ) ) ;
+
+
+$build->config_data( config_done => 1 ) ;
+
+
+#print Dumper \%{ $build->config_data() };
+
$build->create_build_script() ;
exit ;
+
+1 ;
-package BuildStem ;
+package BuildStem;
use strict;
-use warnings qw( all );
+use warnings;
-use Carp ;
use Config;
-use File::Path ;
-use File::Spec ;
+use File::Basename;
+use File::Spec;
+use IO::File;
-use lib 'lib' ;
-use base 'Module::Build' ;
+use Module::Build;
-$ENV{HARNESS_DEBUG} = 1 ;
-$ENV{HARNESS_VERBOSE} = 1 ;
+use vars qw(@ISA);
+@ISA = qw(Module::Build);
-# 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;
+ my $files = $self->find_script_files();
+ return unless keys %$files;
+
+ my $script_dir = File::Spec->catdir($self->blib, 'script');
+ my $demo_dir = File::Spec->catdir($self->blib, 'demo');
+ File::Path::mkpath( $script_dir );
+ File::Path::mkpath( $demo_dir );
+ $self->add_to_cleanup($demo_dir);
+
+ foreach my $file (keys %$files) {
+ my $dest_dir = $file =~ /_demo$/ ? $demo_dir : $script_dir ;
+ my $result = $self->copy_if_modified($file, $dest_dir, 'flatten') or next;
+ $self->fix_shebang_line($result) if $self->is_unixish();
+ $self->make_executable($result);
+ my $demo_run_dir = File::Spec->catdir($self->base_dir(), 'demo');
+ if ( $result =~ /(?:run_stem$)|(?:_demo$)/ ) {
+ my $result2 = $self->copy_if_modified($result, $demo_run_dir, 'flatten') or next;
+ $self->add_to_cleanup($result2);
}
}
-
- 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
-
+ return 1;
}
-sub install_config_files {
-
+sub process_conf_files {
my ( $self ) = @_ ;
+ my $files = $self->_find_file_by_type('stem','conf');
+ return unless keys %$files;
- 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$} ) ;
+ my $conf_dir = File::Spec->catdir($self->blib, 'conf');
+ File::Path::mkpath( $conf_dir );
- 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 );
+ foreach my $file (keys %$files) {
+ my $result = $self->copy_if_modified($file, $conf_dir, 'flatten') or next;
+ $self->fix_shebang_line($result) if $self->is_unixish();
}
+ return 1;
}
-
-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 ;
+sub find_binary {
+ my ( $self, $prog ) = @_ ;
+ if ( $self->do_system( "which $prog >/dev/null" ) ) {
+ return `which $prog` ;
}
-
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 ;
+1;
People besides Uri who've contributed to Stem code and docs:
Dave Rolsky - various code, bug fixes, docs, etc.
+Stephen R. Scaffidi - various bug fixes, docs, etc.
-Makefile.PL
+bin/boot_stem
+bin/cgi2stem.pl
+bin/chat2_demo
+bin/chat_demo
+bin/cli
+bin/hello_demo
+bin/inetd_demo
+bin/quote_serve
+bin/run_stem
+bin/stem2pod
+bin/stem_msg
+bin/tail_demo
Build.PL
BuildStem.pm
-META.yml
-MANIFEST
+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
CHANGELOG
-COPYING
-CREDITS
-README
-INSTALL
-LICENSE
-TODO
-DEMO
-DEMO_CHAT
-DEMO_INETD
-DEMO_TAIL
+conf/archive.stem
+conf/boot.stem
+conf/chat.stem
+conf/chat_client.stem
+conf/chat_label.stem
+conf/chat_server.stem
+conf/cli.stem
+conf/cron.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_flow.stem
+conf/test_packet_io.stem
+conf/test_udp.stem
+conf/ticker.stem
+conf/ttysock.stem
+conf/type.stem
+conf/x.stem
Cookbook/cookbook.txt
Cookbook/World1.pm
Cookbook/World2.pm
Cookbook/World4.pm
Cookbook/World5.pm
Cookbook/worlds.stem
-Design/asyncio_notes
-Design/Stem-Mon
+COPYING
+CREDITS
+DEMO
+DEMO_CHAT
+DEMO_INETD
+DEMO_TAIL
Design/arch_notes
-Design/config_notes
+Design/asyncio_notes
Design/cell_notes
+Design/config_notes
Design/console_notes
Design/cron_notes
Design/debug_notes
Design/security_notes
Design/sock_msg_notes
Design/socket_notes
+Design/Stem-Mon
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
+FAQ/faq.text
+FAQ/faq_maker.pl
+INSTALL
lib/Stem.pm
+lib/Stem/AsyncIO.pm
+lib/Stem/Boot.pm
+lib/Stem/Cell.pm
+lib/Stem/Cell/Clone.pm
+lib/Stem/Cell/Flow.pm
+lib/Stem/Cell/Pipe.pm
+lib/Stem/Cell/Sequence.pm
+lib/Stem/Cell/Work.pm
+lib/Stem/ChatLabel.pm
+lib/Stem/Class.pm
+lib/Stem/Codec.pm
+lib/Stem/Codec/Data/Dumper.pm
+lib/Stem/Codec/Storable.pm
+lib/Stem/Codec/YAML.pm
+lib/Stem/Conf.pm
+lib/Stem/Console.pm
+lib/Stem/Cron.pm
+lib/Stem/DBI.pm
+lib/Stem/Debug.pm
+lib/Stem/Demo/CLI.pm
+lib/Stem/Demo/World.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/Signal.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/File.pm
+lib/Stem/Gather.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/Id.pm
+lib/Stem/Inject.pm
+lib/Stem/InstallConfig.pm
+lib/Stem/Load/Driver.pm
+lib/Stem/Load/Ticker.pm
lib/Stem/Log.pm
lib/Stem/Log/Entry.pm
lib/Stem/Log/File.pm
lib/Stem/Log/Tail.pm
+lib/Stem/Msg.pm
+lib/Stem/Packet.pm
+lib/Stem/Portal.pm
+lib/Stem/Proc.pm
+lib/Stem/Route.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
+lib/Stem/Trace.pm
+lib/Stem/TtySock.pm
+lib/Stem/UDPMsg.pm
+lib/Stem/Util.pm
+lib/Stem/Vars.pm
+lib/Stem/WorkQueue.pm
+LICENSE
+Makefile.PL
+MANIFEST This list of files
+MANIFEST.SKIP
+META.yml
+README
+sessions/backend.pl
+sessions/client.pl
+sessions/mid_event.pl
+sessions/mid_event_async.pl
+t/cell/flow.t
+t/config/test_stem_bug.pl
+t/event/event.t
t/event/event_test.pl
+t/event/gtk.t
t/event/perl.t
-t/event/event.t
t/event/poe.t
+t/event/qt.t
t/event/tk.t
t/event/wx.t
-t/event/gtk.t
-t/event/qt.t
+t/io/packet.t
t/socket/plain.t
t/socket/plain_fork.t
+t/socket/SockFork.pm
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
+TODO
--- /dev/null
+# Version control files and dirs.
+\bRCS\b
+\bCVS\b
+,v$
+\B\.svn\b
+^.git
+^.gitignore
+
+# EUMM/MB generated files and dirs.
+^MANIFEST\.bak
+^_build
+^Build$
+^Makefile$
+^blib/
+^MakeMaker-\d
+
+# demo files so we don't need to install
+^demo/
+
+# Temp, old and emacs backup files.
+~$
+\.old$
+^#.*#$
+^\.#
+\.*.swp$
+
+# other stuff we dont want in the dist tarball
+^notes/
$base_off = 0 ;
$xskip = ( $^O eq 'solaris' ) ? 600 : 500 ;
+use File::Basename qw( basename );
+$ENV{PATH} .= ':' . basename( $0 ) . ':.';
+
+for my $prog qw( run_stem xterm telnet ) {
+ die "Can't find $prog in PATH\n" if
+ system( "which $prog >/dev/null 2>&1" ) != 0;
+}
+
my @children ;
$SIG{ 'INT' } = \&cleanup ;
sleep 2 unless $cmd =~ /localhost/ ;
}
-while( <STDIN> ) {
+1 while wait() != -1;
+
+exit;
- next unless /^q/i ;
- cleanup() ;
-}
sub cleanup {
print "CHAT DEMO\n" ;
+use File::Basename qw( basename );
+$ENV{PATH} .= ':' . basename( $0 ) . ':.';
+for my $prog qw( run_stem xterm telnet ) {
+ die "Can't find $prog in PATH\n" if
+ system( "which $prog >/dev/null 2>&1" ) != 0;
+}
+
my @children ;
$SIG{ 'INT' } = \&cleanup ;
sleep 4 unless $cmd =~ /localhost/ ;
}
+1 while wait() != -1;
-while( <STDIN> ) {
+exit;
- next unless /^q/i ;
- cleanup() ;
-}
sub cleanup {
use warnings ;
our $s ;
-if ( -d 'conf' && -e 'bin/run_stem' ) {
+print "HELLO DEMO\n" ;
- $ENV{PERL5LIB} = 'lib' ;
- $ENV{PATH} = "bin:$ENV{PATH}" ;
+use File::Basename qw( basename );
+$ENV{PATH} .= ':' . basename( $0 ) . ':.';
+for my $prog qw( run_stem xterm ) {
+ die "Can't find $prog in PATH\n" if
+ system( "which $prog >/dev/null 2>&1" ) != 0;
}
-print "HELLO DEMO\n" ;
$SIG{ 'INT' } = \&cleanup ;
fork_exec( @cmd ) ;
-while( <STDIN> ) {
+1 while wait() != -1;
+
+exit;
- next unless /^q/i ;
- cleanup() ;
-}
sub cleanup {
print "INETD: $ENV{PATH}\n" ;
+use File::Basename qw( basename );
+$ENV{PATH} .= ':' . basename( $0 ) . ':.';
+for my $prog qw( run_stem xterm telnet ) {
+ die "Can't find $prog in PATH\n" if
+ system( "which $prog >/dev/null 2>&1" ) != 0;
+}
+
$SIG{ 'INT' } = \&cleanup ;
if ( $s ) {
sleep 4 unless $cmd =~ /localhost/ ;
}
+1 while wait() != -1;
-while( <STDIN> ) {
+exit;
- next unless /^q/i ;
- cleanup() ;
-}
sub cleanup {
-#!/usr/local/bin/perl -w
+#!/usr/bin/perl -w
+
+eval 'exec /usr/bin/perl -w -S $0 ${1+"$@"}'
+ if 0; # not running under some shell
# File: bin/run_stem
# This file is part of Stem.
# Arlington, MA 02474
# USA
+
+eval { use lib 'blib/lib' } if -d 'blib/lib';
+eval { use lib '../blib/lib' } if -d '../blib/lib';
+
$Data::Dumper::Indent = 1 ;
$Data::Dumper::Purity = 1 ;
$Data::Dumper::Useqq = 1 ;
-#!/usr/local/bin/perl -w
+#!/usr/bin/perl -w
#
-# stem2pod
+# 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.
+# scans a file containing the code for a stem cell
+# and updates it with pod generated from the cell's
+# attribute variables.
+#
+# also generates pod for detected methods, subs, and
+# any missing standard stuff (author, license, etc.)
#
-# if a file is changed, it is written out over itself. unchanged
-# files are not touched.
use strict;
-
-use Carp qw( carp cluck ) ;
+use warnings;
use Data::Dumper;
+use File::Slurp;
+use Carp;
+
-#use Test::More tests => 1 ;
-#$SIG{__WARN__} = sub { cluck } ;
+# These globals are initalized in the BEGIN block at the bottom of this file
+# Please treat as constants.
+our ( %PRE_POD, %POST_POD );
-my $changed ;
-my $package ;
+# Another global/"constant"
+our %IS_ATTR_PART = map { $_ => 1 } qw(
+ name
+ type
+ help
+ default
+ required
+ class
+ class_args
+);
-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 ) ;
+for my $file_name (@ARGV) {
+ stem2pod($file_name);
}
+exit;
-exit ;
-sub process_source_file {
- my ( $file_name ) = @_ ;
- my $code_text = read_file( $file_name ) ;
+sub stem2pod {
+ my ($file_name) = @_;
- my $new_code_text = process_code_text( $file_name, $code_text ) ;
+ my $file_text = read_file($file_name);
-#print $new_code_text ;
+ my $attr_spec = find_attr_spec( $file_text, $file_name );
- if ( $new_code_text eq $code_text ) {
+ my @meth_names = find_method_names( $file_text );
- print "$file_name SAME\n" ;
- return ;
- }
+ # extract_pod _literally_ extracts it -
+ # removing any pod found from the text.
+ my $new_text = $file_text;
+ my $pod_sections = extract_pod( \$new_text, \@meth_names );
- print "$file_name CHANGED\n" ;
+ my ($class_name) = ($file_text =~ /^package\s+([\w:]+)/m);
- write_file( "$file_name.new, $new_code_text ) ;
+ my $attr_pod = generate_attr_pod( $attr_spec, $file_name, $class_name );
+
+ generate_boilerplate( $file_text, $class_name );
-# write_file( "$file_name.bak, $code_text ) ;
-# write_file( $file_name, $new_code_text ) ;
+ my $new_pod = generate_pod( $attr_pod, \@meth_names, $pod_sections );
-}
+ my $new_source = build_source( $new_pod, $new_text );
+
+ if ( $file_text eq $new_source ) {
+ warn "No changes to make to $file_name\n";
+ return;
+ }
-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 ;
+ write_file( "$file_name.new", $new_source );
}
-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" ;
+# Finds and returns a list of the names of
+# methods/subroutines found in the file
+sub find_method_names {
+ my ( $file_text ) = @_;
- $attr_text =~ s/\s*\z// ;
+ my @meth_names = $file_text =~ /^sub\s+([^\W_]\w*)/gm;
- 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" ;
+ return @meth_names;
+}
-#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
+# Find and _remove_ any POD in the file.
+# Returns a HoH-like data-structure that you should probably inspect
+# with DD to see what it looks like...
+sub extract_pod {
+ my ( $text_ref, $method_names ) = @_;
+ my %pod_sections;
+ my @pod_names;
+ while ( ${$text_ref} =~
+ s{
+ ^ # begin of line
+ ( # grab pod head line as $1
+ =head\w* # begin pod section
+ \s+
+ (.+?)$ # grab section title as $2
+ )
+ (
+ .+? # grab pod body as $3
+ )
+ (?: # match until after =cut, before =head or at EOF
+ ^=cut
+ | (?=^=head)
+ | \z
+ )
+ }{}mxs
+ ) {
+ my $head = $1;
+ my $title = $2;
+ my $body = $3;
+
+# # strip out leading and trailing blank lines
+# $body =~ s/\A[\n]\s*[\n]|[\n]\s*[\n]\z//msg;
+
+ # Does the section title contain the name of a method?
+ my ($method_name) = grep { $title =~ /$_/i and $_ } @$method_names;
+ if ( $method_name ) {
+
+ warn "Duplicate pod section for method "
+ . "$method_name named [$title].\n"
+ if exists $pod_sections{methods}{$method_name};
+
+ $pod_sections{methods}{$method_name}{head} = $head;
+ $pod_sections{methods}{$method_name}{body} = $body;
+
+ next;
+ }
+
+ warn "Found pod section with duplicate name [$title]\n"
+ if exists $pod_sections{other}{ lc $title };
+
+ $pod_sections{other}{ lc $title }{head} = $head;
+ $pod_sections{other}{ lc $title }{body} = $body;
+ }
+# print Dumper \%pod_sections; exit;
+ return \%pod_sections;
+}
-#print "POD [$pod]\n" ;
- foreach my $attr_ref ( @{$attr_list} ) {
- my $name = $attr_ref->{name} ;
- if ( $name ) {
- $pod .= <<POD ;
+# Generate all the POD text in one big chunk...
+# Fill in most sections with boilerplate, but will
+# merge in sections that were already present ( found by extract_pod() )
+sub generate_pod {
+ my ( $attr_pod, $meth_names, $pod_sections ) = @_;
-=item * Attribute - B<$name>
+ my $new_pod;
-=over 4
+ $new_pod .= generate_pod_sections( $pod_sections, \%PRE_POD );
-POD
- }
- else {
+ # attr_pod is always regenerated...
+ # TODO: perhaps it's better to call generate_attr_pod() here?
+ if ($attr_pod) {
+ $new_pod .= "=head1 ATTRIBUTES\n\n";
+ $new_pod .= strip_blank_lines( $attr_pod ) . "\n\n";
+ }
- warn <<WARN ;
-Missing attribute name in Class $package in file $file_name
-WARN
+ $new_pod .= "=head1 METHODS\n\n";
+ foreach my $meth_name ( @$meth_names ) {
- next ;
- }
+ $new_pod .= "=head2 $meth_name\n\n";
+ if ( my $meth_pod = $pod_sections->{methods}{$meth_name} ) {
+ $new_pod .= strip_blank_lines( $meth_pod->{body} ) . "\n\n";
+ next;
+ }
- my $help = $attr_ref->{help} ;
+ if ( $meth_name eq 'new' ) {
+ $new_pod .= strip_blank_lines( <<END_POD ) . "\n\n";
- if ( defined( $help ) ) {
+This is a class method that constructs the object. It uses
+the standard Stem API of key/value attributes. These are described
+in the \$attr_spec in the module, and it's POD is auto-generated.
- $pod .= <<POD ;
+END_POD
+ next;
+ }
-=item Description:
+ if ( $meth_name eq 'msg_in' ) {
+ $new_pod .= strip_blank_lines( <<END_POD ) . "\n\n";
-$help
-POD
- }
- else {
+This method is the 'wildcard' Stem message handler and it is passed a single
+argument which is a L<Stem::Msg> object. This method is called if no
+specific message handler method is found in this cell. This is missing
+specific documentation to be filled in.
- warn <<WARN ;
-Missing help in attribute $name in Class $package in file $file_name
-WARN
- }
+END_POD
+ next;
+ }
- if ( my $attr_class = $attr_ref->{class} ) {
+ if ( $meth_name =~ /^(.+)_in$/ ) {
+ my $msg_type = $1;
+ $new_pod .= strip_blank_lines( <<END_POD ) . "\n\n";
- my $class_args = '<' .
- join( ', ', @{$attr_ref->{class_args} || []} )
- . '>' ;
+This method is a Stem message handler for messages of type $msg_type.
+It is passed a single argument which is a L<Stem::Msg> object and
+its return value is ignored. This is missing specific documentation
+to be filled in.
- $pod .= <<POD ;
+END_POD
+ next;
+ }
-=item Class Attribute:
+ if ( $meth_name =~ /^(.+)_cmd$/ ) {
+ my $cmd_type = $1;
+ $new_pod .= strip_blank_lines( <<END_POD ) . "\n\n";
-'$name' is an object of class $attr_class and constructed with:
-$class_args
-POD
- }
+This method is a Stem message handler for command messages of type $cmd_type.
+It is passed a single argument which is a L<Stem::Msg> object.
+Any return value will be sent back as a 'response' type message to the sender.
+This is missing specific documentation to be filled in.
+END_POD
+ next;
+ }
- exists( $attr_ref->{type} ) and $pod .= <<POD ;
+ # All other methods just get this...
+ $new_pod .= "This method is missing documentation\n\n";
+ }
-=item The type of '$name' is:
+ $new_pod .= generate_pod_sections( $pod_sections, \%POST_POD );
+
+ $new_pod .= "=cut\n\n";
-$attr_ref->{type}
-POD
+ return $new_pod;
+}
- if ( exists( $attr_ref->{default} ) ) {
- my $default = $attr_ref->{default} ;
+sub generate_pod_sections {
+ my ($existing_pod, $bp_pod) = @_;
+
+ my $new_pod;
- if( ref($default) eq "ARRAY" ) {
+ foreach my $section ( @{ $bp_pod->{names} } ) {
- $default =
- '(' . join( ', ', @{$default} ) . ')' ;
- }
+ (my $printable_section = $section) =~ tr/_/ /;
+ $new_pod .= "=head1 $printable_section\n\n";
- $pod .= <<POD
+ my $found_sec = $existing_pod->{other}{ lc $section };
+
+ my $next_part = $found_sec ?
+ $found_sec->{body} : $bp_pod->{boilerplate}{$section} ;
-=item B<Default> value:
+ $new_pod .= strip_blank_lines( $next_part ) . "\n\n";
+ }
-$default
-POD
- }
+ return $new_pod;
+}
- exists( $attr_ref->{required} ) and $pod .= <<POD ;
-=item It is B<required>.
-POD
+sub generate_boilerplate {
+ my ($file_text, $class_name) = @_;
- foreach my $attr ( sort keys %{ $attr_ref } ) {
- next if $is_attr_part{ $attr } ;
- $pod .= "Unknown attribute $attr\n" ;
- }
+ $PRE_POD{boilerplate}{NAME} = <<END_POD;
+$class_name
+END_POD
- $pod .= <<POD ;
+ if ($file_text =~ /\$attr_spec/) {
+ $POST_POD{boilerplate}{SEE_ALSO} = <<END_POD;
+L<Stem::Class>
+END_POD
+ }
-=back
+return;
+}
-POD
- }
+# strip out leading and trailing blank lines
+sub strip_blank_lines {
+ my ($text) = @_;
+ $text =~ s/\A[\n]?\s*[\n]|[\n]\s*[\n]?\z//msg;
+ return $text;
+}
- $pod .= <<POD ;
-=back
+# tries to locate the $attr_spec array ref in the text
+# and returns it as a real data structure (eval magick)
+sub find_attr_spec {
+ my ( $file_text, $file_name ) = @_;
-=cut
+ # The regex below is naive but will be fine for now. I would
+ # prefer to use Text::Balanced or Regexp::Common though...
+ my $attr_spec;
+ if ( $file_text =~ /\$attr_spec\s*=\s*(\[[^\]]*\])\s*;/ ) {
+ $attr_spec = eval $1
+ or croak "Error parsing \$attr_spec from $file_name:\n$@\n";
+ }
-# End of autogenerated POD
-###########
+ return $attr_spec;
+}
-POD
-#print "[$pod]" ;
-#print "POD2 [", substr($pod, 0, 40), "]\n" ;
- return "$attr_text\n\n$pod" ;
+
+# blow away __END__ and everything after (if present)
+# and replace with generated POD
+sub build_source {
+ my ( $new_pod, $file_text ) = @_;
+
+ ( my $new_text = $file_text ) =~ s/^__END__[\n].*//msg;
+
+ return $new_text . "__END__\n\n" . $new_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 ) ;
+# Stolen from uri's original script, but really,
+# really needs to be cleaned up...
+# TODO: clean up this sub, somehow...
+sub generate_attr_pod {
+ my ( $attr_list, $file_name, $package ) = @_;
-#dump_new( 'CUT', $cut_text ) ;
-#dump_new( 'DESC', $desc ) ;
-#print "CUT2 [$cut_text]\nDESC [$desc]\n" if $name eq 'new' ;
+ my $pod .= <<POD ;
- my $pod = <<POD ;
-$cut_text$desc
-=cut
+=head2 Class Attributes for $package
+
+This pod is generated from the \$attr_spec in the module.
+That data is also used by L<Stem::Class> to parse the arguments
+passed to the class constructor new().
+
+=over 4
-sub $name
POD
- chomp $pod ;
+ #print "POD [$pod]\n" ;
-#print "SUB2 [$pod]\n" if $name eq 'new' ;
+ foreach my $attr_ref ( @{$attr_list} ) {
- return $pod ;
-}
+ my $name = $attr_ref->{name};
+
+ unless ($name) {
-sub get_sub_pod {
+ warn <<WARN ;
+Missing attribute name in Class $package in file $file_name
+WARN
+ next;
+ }
- my ( $name ) = @_ ;
+ $pod .= <<POD ;
- return <<POD if $name eq 'new' ;
-=head3 Constructor - B<new>
+=item * B<$name>
-The B<new> method creates an object of the class B<$package>.
+=over 4
POD
- return <<POD if $name eq 'msg_in' ;
-=head3 Message Handler - B<msg_in>
+ my $help = $attr_ref->{help};
-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
+ unless ( defined($help) ) {
+ warn <<WARN ;
+Missing help in attribute $name in Class $package in file $file_name
+WARN
+ next;
+ }
- return <<POD if $name =~ /(\w+)_in$/ ;
-=head3 Message Handler - $name
+ $pod .= <<POD ;
-B<$1> type messages are delivered to this method. Its return value is
-ignored by the message delivery system.
+=item - $help
POD
+# suppress line break in POD output after description
+ chomp $pod;
+
+ if ( my $attr_class = $attr_ref->{class} ) {
- return <<POD if $name =~ /(\w+)_cmd$/ ;
-=head3 Command Message Handler - $name
+ my $class_args =
+ '<' . join( ', ', @{ $attr_ref->{class_args} || [] } ) . '>';
-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 .= <<POD ;
+=item - Class Attribute: '$name' is an object of class $attr_class and constructed with: $class_args
POD
+ }
- return <<POD ;
-=head3 Method - $name
+ exists( $attr_ref->{type} ) and $pod .= <<POD ;
+
+=item - The type of '$name' is: $attr_ref->{type}
POD
-}
+ if ( exists( $attr_ref->{default} ) ) {
-sub update_trailing_pod {
+ my $default = $attr_ref->{default};
- my( $tail_text ) = @_ ;
+ if ( ref($default) eq "ARRAY" ) {
-# return $tail_text if $tail_text =~ /=cut/ ;
+ $default = '(' . join( ', ', @{$default} ) . ')';
+ }
-#print "1 [$tail_text]\n" ;
+ $pod .= <<POD
- return <<POD ;
+=item - B<Default> value: $default
+POD
+ }
-=head1 Bugs
+ exists( $attr_ref->{required} ) and $pod .= <<POD ;
-=head1 Todo
+=item - It is B<required>.
+POD
-=head1 See Also
+ foreach my $attr ( sort keys %{$attr_ref} ) {
+ next if $IS_ATTR_PART{$attr};
+ $pod .= "Unknown attribute $attr\n";
+ }
-=head1 Author
+ $pod .= <<POD ;
+
+=back
+
+POD
+ }
-Uri Guttman, E<lt>uri\@stemsystems.comE<gt>
+ $pod .= <<POD ;
+
+=back
=cut
-1 ;
POD
+ #print "[$pod]" ;
+
+ #print "POD2 [", substr($pod, 0, 40), "]\n" ;
+
+ return $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 @_ ;
-}
+# Globals declared at the top of this script are initalized here
+# Keeping at the bottom of this file to (try to) reduce clutter.
+BEGIN {
+
+ # Pod sections that go before attribute and method sections
+ my @PRE_POD_NAMES = qw( NAME SYNOPSIS DESCRIPTION );
+
+ # sections that go after
+ my @POST_POD_NAMES = qw( BUGS TODO SEE_ALSO AUTHOR LICENSE COPYRIGHT );
+
+
+ # Boilerplate for each "pre" section
+ my %PRE_POD_BP = (
+
+ NAME => <<'END_POD',
+Name of module
+END_POD
+
+ SYNOPSIS => <<'END_POD',
+Code/config example
+END_POD
+
+ DESCRIPTION => <<'END_POD',
+What is this module good for?
+END_POD
+
+ );
+
+
+ # Boilerplate for each "post" section
+ my %POST_POD_BP = (
+
+ BUGS => <<'END_POD',
+None
+END_POD
+
+ TODO => <<'END_POD',
+END_POD
+
+ SEE_ALSO => <<'END_POD',
+END_POD
+
+ AUTHOR => <<'END_POD',
+Uri Guttman uri@cpan.org
+END_POD
+
+ LICENSE => <<'END_POD',
+Same as Perl
+END_POD
+
+ COPYRIGHT => <<'END_POD',
+(C) Uri Guttman, 2009
+END_POD
+
+ );
-sub dump_attr {
- my( $key, $text ) = @_ ;
+ # globals used in other parts of the program
+ %PRE_POD = (
+ names => \@PRE_POD_NAMES,
+ boilerplate => \%PRE_POD_BP,
+ );
- $text =~ /(;\s+#{3,})/s or return ;
+ %POST_POD = (
+ names => \@POST_POD_NAMES,
+ boilerplate => \%POST_POD_BP,
+ );
- print "$key [$1]\n" ;
}
-__END__
$base_off = 0 ;
$xskip = ( $^O eq 'solaris' ) ? 600 : 500 ;
+use File::Basename qw( basename );
+$ENV{PATH} .= ':' . basename( $0 ) . ':.';
+for my $prog qw( run_stem xterm telnet ) {
+ die "Can't find $prog in PATH\n" if
+ system( "which $prog >/dev/null 2>&1" ) != 0;
+}
+
my @children ;
my $tail_dir = 'tail' ;
sleep 2 ;
}
-while( <STDIN> ) {
+1 while wait() != -1;
+
+exit;
- next unless /^q/i ;
- cleanup() ;
-}
sub cleanup {
--- /dev/null
+# x.stem
+#
+[
+ class => 'Stem::SockMsg',
+ name => 'Xterm',
+ args => [
+
+ port => 6010,
+ host => 'localhost',
+ server => 1,
+ cell_attr => [
+ 'data_addr' => 'XServer',
+ ],
+ ],
+],
+[
+ class => 'Stem::SockMsg',
+ name => 'XServer',
+ args => [
+ connect_now => 1,
+ port => 6000,
+ cell_attr => [
+ 'data_addr' => 'Xterm',
+ ],
+ ],
+],
no strict 'refs' ;
- unless ( %{"::${class}"} ) {
+ my %loaded_packages = map { $_ => 1 } keys %{*{"main\::"}};
+
+ unless ( $loaded_packages{"$class\::"} ) {
+
+#print "attempting to load $class\n";
my $module = $class ;
$module =~ s{::}{/}g ;
my $loop_class = _get_loop_class() ;
-init_loop() ;
+INIT{ init_loop() ; }
sub init_loop {
+Stem::Event::Queue::_init_queue() if defined &Stem::Event::Queue::_init_queue ;
+
$loop_class->_init_loop() ;
+<<<<<<< HEAD:lib/Stem/Event.pm
#Stem::Event::Queue::_init_queue() if defined &Stem::Event::Queue::_init_queue ;
+=======
+>>>>>>> master:lib/Stem/Event.pm
}
$loop_type = 'perl' unless $loop_to_class{ $loop_type } ;
my $loop_class = "Stem::Event::$loop_to_class{ $loop_type }" ;
+print "LOOP $loop_class\n" ;
+
unless ( eval "require $loop_class" ) {
die "can't load $loop_class: $@" if $@ && $@ !~ /locate/ ;
+print "not found\n" ;
+
$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 ;
+<<<<<<< HEAD:lib/Stem/Event.pm
+=======
+>>>>>>> master:lib/Stem/Event.pm
our @ISA = qw( Stem::Event ) ;
=head2 Stem::Event::Plain::new
############################################################################
package Stem::Event::Signal ;
+<<<<<<< HEAD:lib/Stem/Event.pm
+=======
+>>>>>>> master:lib/Stem/Event.pm
our @ISA = qw( Stem::Event ) ;
=head2 Stem::Event::Signal::new
############################################################################
package Stem::Event::Timer ;
+<<<<<<< HEAD:lib/Stem/Event.pm
+=======
+>>>>>>> master:lib/Stem/Event.pm
our @ISA = qw( Stem::Event ) ;
=head2 Stem::Event::Timer::new
# these override Stem::Event's methods and then call those via SUPER::
package Stem::Event::IO ;
+<<<<<<< HEAD:lib/Stem/Event.pm
+=======
+>>>>>>> master:lib/Stem/Event.pm
our @ISA = qw( Stem::Event ) ;
sub init_io_timeout {
#######################################################
package Stem::Event::Read ;
+our @ISA = qw( Stem::Event::IO ) ;
+print "B @ISA\n" ;
+<<<<<<< HEAD:lib/Stem/Event.pm
our @ISA = qw( Stem::Event::IO ) ;
+=======
+>>>>>>> master:lib/Stem/Event.pm
=head2 Stem::Event::Read::new
sub new {
my( $class ) = shift ;
+print "@ISA\n" ;
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
############################################################################
package Stem::Event::Write ;
+<<<<<<< HEAD:lib/Stem/Event.pm
+=======
+>>>>>>> master:lib/Stem/Event.pm
our @ISA = qw( Stem::Event::IO ) ;
=head2 Stem::Event::Write::new
=cut
package Stem::Event::Perl ;
+our @ISA = qw( Stem::Event ) ;
use strict ;
use Stem::Event::Signal ;
-@Stem::Event::Perl::ISA = qw( Stem::Event ) ;
-
BEGIN {
unless ( eval { require Time::HiRes } ) {
package Stem::Event::Queue ;
+our @ISA = qw( Stem::Event ) ;
use strict ;
use warnings ;
use Socket;
use IO::Handle ;
+<<<<<<< HEAD:lib/Stem/Event/Queue.pm
my( $self, $queue_read, $queue_write, $queue_read_event, $queue_has_event ) ;
+=======
+use base 'Exporter' ;
+our @EXPORT = qw( mark_not_empty ) ;
+>>>>>>> master:lib/Stem/Event/Queue.pm
sub _init_event_queue {
$SIG{ $signal } = $cached_handlers{$signal} ||=
sub {
+<<<<<<< HEAD:lib/Stem/Event/Signal.pm
Stem::Event::Queue::queue_has_event() ;
#print "HIT $signal\n";
+=======
+print "HIT $signal\n";
+ Stem::Event::Queue::mark_not_empty() ;
+>>>>>>> master:lib/Stem/Event/Signal.pm
push @signal_queue, $signal
} ;
--- /dev/null
+package Stem::InstallConfig;
+
+use strict;
+use warnings;
+
+use Stem::ConfigData;
+
+our %Config =
+ map { $_ => Stem::ConfigData->config( $_ ) }
+ Stem::ConfigData->config_names();
+
+our %__PACKAGE__ = %Config;
+
+#use Data::Dumper; print Dumper \%Config, \%__PACKAGE__; exit;
+
+1;
}
elsif ( $self->{'connect_now'} ) {
+#print "NOW\n" ;
+
$self->connect() ;
}
TraceStatus "\n$info" ;
+#print "\n$info" ;
+
if ( my $log_name = $self->{ 'log_name' } ) {
#print "MSG LOG\n" ;
my( $self ) = @_ ;
#print "SockMsg triggered\n" ;
+ return if $self->{'connected'} ;
return if $self->{'server'} ;
# return "SockMsg: can't connect a server socket" if $self->{'server'} ;
--- /dev/null
+Odd sort of behavior... when dumping \%:: with Data::Dumper in Stem/Conf.pm
+(insert a print @ line 234)
+
+the program just "freezes"...
+
+
--- /dev/null
+#!/usr/bin/env perl
+
+use strict ;
+use warnings ;
+use Test::More tests => 2;
+use Test::Exception;
+
+use_ok( 'Stem' );
+
+my @config = (
+ { class => 'Foobar', },
+ { class => 'Stem::Console', },
+) ;
+
+
+lives_ok( sub { Stem::Conf::configure( \@config ) }, 'load config from data structure' );
+
+package Foobar ;
+
+sub foobar_cmd { return "FOOBAR!!!\n" }
+
+
my( $self ) = @_ ;
+<<<<<<< HEAD:t/event/event_test.pl
ok( 1, 'plain - event triggered' ) ;
+=======
+ ok( 1, 'plain event triggered' ) ;
+ Stem::Event::stop_loop() ;
+>>>>>>> master:t/event/event_test.pl
}
sub test_signal_events {
return ;
}
+ my $event2 = Stem::Event::Timer->new(
+ 'object' => $self,
+ 'method' => 'send_int_signal',
+ 'delay' => 3,
+ ) ;
+
+ ok( ref $event2, 'signal delay timer created' ) ;
+
+ Stem::Event::start_loop() ;
+
+ ok( 1, 'signal - event loop exit' ) ;
+ }
+}
+
+sub send_int_signal {
+
my $event = Stem::Event::Signal->new(
'object' => $self,
'signal' => 'INT',
$self->{'sig_event'} = $event ;
- kill 'INT', $$ ;
-
-#print "kill INT\n" ;
- Stem::Event::start_loop() ;
+print "kill INT\n" ;
- ok( 1, 'signal - event loop exit' ) ;
- }
+ kill 'INT', $$ ;
}
# callback method for signal
my( $self ) = @_ ;
+<<<<<<< HEAD:t/event/event_test.pl
ok( 1, 'hard timer - event triggered' ) ;
+=======
+send_int_signal() ;
+
+ ok( 1, 'hard timer event triggered' ) ;
+>>>>>>> master:t/event/event_test.pl
if ( --$self->{'hard_timer_count'} > 0 ) {
projects / urisagit/Stem.git / commitdiff