From: Uri Guttman Date: Tue, 15 Sep 2009 17:54:48 +0000 (-0400) Subject: merging X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d88e43718237ee11b2a4458ed280dccfe6aea2d7;hp=6b7be1100e75ca4ac0b5b9a3811dee268fafe2b6;p=urisagit%2FStem.git merging --- diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..ec302ab --- /dev/null +++ b/.gitignore @@ -0,0 +1,37 @@ +# 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 + + diff --git a/Build.PL b/Build.PL index 35743fb..3da144c 100644 --- a/Build.PL +++ b/Build.PL @@ -1,33 +1,239 @@ -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 ; diff --git a/BuildStem.pm b/BuildStem.pm index 3711f98..581e12f 100644 --- a/BuildStem.pm +++ b/BuildStem.pm @@ -1,852 +1,67 @@ -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 ; - - 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= (default is all .pm files) -# re= - -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= -# -# 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= (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, <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 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; diff --git a/CREDITS b/CREDITS index a83b226..130fd45 100644 --- a/CREDITS +++ b/CREDITS @@ -1,3 +1,4 @@ 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. diff --git a/MANIFEST b/MANIFEST index 141fa26..49403df 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1,19 +1,53 @@ -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 @@ -21,11 +55,16 @@ Cookbook/World3.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 @@ -42,133 +81,98 @@ Design/registry_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 diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP new file mode 100644 index 0000000..873403d --- /dev/null +++ b/MANIFEST.SKIP @@ -0,0 +1,28 @@ +# 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/ diff --git a/bin/chat2_demo b/bin/chat2_demo index a2006a9..b23a14f 100755 --- a/bin/chat2_demo +++ b/bin/chat2_demo @@ -5,6 +5,14 @@ $offset = 175 ; $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 ; @@ -41,12 +49,11 @@ print "$cmd\n" ; sleep 2 unless $cmd =~ /localhost/ ; } -while( ) { +1 while wait() != -1; + +exit; - next unless /^q/i ; - cleanup() ; -} sub cleanup { diff --git a/bin/chat_demo b/bin/chat_demo index 8437913..435af50 100755 --- a/bin/chat_demo +++ b/bin/chat_demo @@ -7,6 +7,13 @@ $xskip = ( $^O eq 'solaris' ) ? 600 : 500 ; 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 ; @@ -42,13 +49,11 @@ print "$cmd\n" ; sleep 4 unless $cmd =~ /localhost/ ; } +1 while wait() != -1; -while( ) { +exit; - next unless /^q/i ; - cleanup() ; -} sub cleanup { diff --git a/bin/hello_demo b/bin/hello_demo old mode 100644 new mode 100755 index 5b525c1..313c5c1 --- a/bin/hello_demo +++ b/bin/hello_demo @@ -4,13 +4,15 @@ use strict ; 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 ; @@ -30,12 +32,11 @@ s/:/: / for @cmd ; fork_exec( @cmd ) ; -while( ) { +1 while wait() != -1; + +exit; - next unless /^q/i ; - cleanup() ; -} sub cleanup { diff --git a/bin/inetd_demo b/bin/inetd_demo index 9116feb..9556f69 100755 --- a/bin/inetd_demo +++ b/bin/inetd_demo @@ -9,6 +9,13 @@ my @children ; 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 ) { @@ -42,13 +49,11 @@ print "CMD $cmd\n" ; sleep 4 unless $cmd =~ /localhost/ ; } +1 while wait() != -1; -while( ) { +exit; - next unless /^q/i ; - cleanup() ; -} sub cleanup { diff --git a/bin/run_stem b/bin/run_stem index 1d20a3f..0dbe445 100755 --- a/bin/run_stem +++ b/bin/run_stem @@ -1,4 +1,7 @@ -#!/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. @@ -27,6 +30,10 @@ # 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 ; diff --git a/bin/stem2pod b/bin/stem2pod index 97143d5..6e070af 100755 --- a/bin/stem2pod +++ b/bin/stem2pod @@ -1,410 +1,532 @@ -#!/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 .= <{name} ; - if ( $name ) { - $pod .= < + 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 <{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( < 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 <{class} ) { + if ( $meth_name =~ /^(.+)_in$/ ) { + my $msg_type = $1; + $new_pod .= strip_blank_lines( <{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 object and +its return value is ignored. This is missing specific documentation +to be filled in. - $pod .= < 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 .= <{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 .= <{other}{ lc $section }; + + my $next_part = $found_sec ? + $found_sec->{body} : $bp_pod->{boilerplate}{$section} ; -=item B value: + $new_pod .= strip_blank_lines( $next_part ) . "\n\n"; + } -$default -POD - } + return $new_pod; +} - exists( $attr_ref->{required} ) and $pod .= <. -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 + } -=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 .= < 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 < +=item * B<$name> -The B method creates an object of the class B<$package>. +=over 4 POD - return < + my $help = $attr_ref->{help}; -The B 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 method. If a -command message is delivered and a value is returned by B, a -response message is sent back to the originating cell with that value. -POD + unless ( defined($help) ) { + warn < 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 <{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 .= <{type} ) and $pod .= <{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 .= < value: $default +POD + } -=head1 Bugs + exists( $attr_ref->{required} ) and $pod .= <. +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 .= <uri\@stemsystems.comE + $pod .= < 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__ diff --git a/bin/tail_demo b/bin/tail_demo index ce04d7e..6011199 100755 --- a/bin/tail_demo +++ b/bin/tail_demo @@ -5,6 +5,13 @@ $offset = 175 ; $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' ; @@ -45,12 +52,11 @@ EOT sleep 2 ; } -while( ) { +1 while wait() != -1; + +exit; - next unless /^q/i ; - cleanup() ; -} sub cleanup { diff --git a/conf/x.stem b/conf/x.stem new file mode 100644 index 0000000..acb0df4 --- /dev/null +++ b/conf/x.stem @@ -0,0 +1,26 @@ +# 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', + ], + ], +], diff --git a/lib/Stem/Conf.pm b/lib/Stem/Conf.pm index 8eed0c4..cff47ba 100644 --- a/lib/Stem/Conf.pm +++ b/lib/Stem/Conf.pm @@ -230,7 +230,11 @@ sub configure { 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 ; diff --git a/lib/Stem/Event.pm b/lib/Stem/Event.pm index 9c2caef..712ccc7 100644 --- a/lib/Stem/Event.pm +++ b/lib/Stem/Event.pm @@ -64,14 +64,19 @@ my %loop_to_class = ( 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 } @@ -295,19 +300,25 @@ sub _get_loop_class { $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 ; } @@ -315,7 +326,10 @@ sub _get_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 @@ -372,7 +386,10 @@ sub 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 @@ -459,7 +476,10 @@ sub 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 @@ -649,7 +669,10 @@ sub timer_triggered { # 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 { @@ -723,8 +746,13 @@ sub timed_out { ####################################################### 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 @@ -802,10 +830,12 @@ HELP sub new { my( $class ) = shift ; +print "@ISA\n" ; my $self = Stem::Class::parse_args( $attr_spec_read, @_ ) ; return $self unless ref $self ; + # return <{fh} ; # Stem::Event::Read: $self->{fh} is not an open handle # ERR @@ -822,7 +852,10 @@ sub new { ############################################################################ 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 diff --git a/lib/Stem/Event/Perl.pm b/lib/Stem/Event/Perl.pm index f614da7..6974027 100644 --- a/lib/Stem/Event/Perl.pm +++ b/lib/Stem/Event/Perl.pm @@ -35,12 +35,11 @@ API for the standard classes: =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 } ) { diff --git a/lib/Stem/Event/Queue.pm b/lib/Stem/Event/Queue.pm index 53db4fa..c473237 100644 --- a/lib/Stem/Event/Queue.pm +++ b/lib/Stem/Event/Queue.pm @@ -41,6 +41,7 @@ package Stem::Event::Queue ; +our @ISA = qw( Stem::Event ) ; use strict ; use warnings ; @@ -48,7 +49,12 @@ 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 { diff --git a/lib/Stem/Event/Signal.pm b/lib/Stem/Event/Signal.pm index 95e1023..6523103 100644 --- a/lib/Stem/Event/Signal.pm +++ b/lib/Stem/Event/Signal.pm @@ -32,9 +32,14 @@ sub _build { $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 } ; diff --git a/lib/Stem/InstallConfig.pm b/lib/Stem/InstallConfig.pm new file mode 100644 index 0000000..db6c3f7 --- /dev/null +++ b/lib/Stem/InstallConfig.pm @@ -0,0 +1,16 @@ +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; diff --git a/lib/Stem/SockMsg.pm b/lib/Stem/SockMsg.pm index 2accf18..2df2f3b 100644 --- a/lib/Stem/SockMsg.pm +++ b/lib/Stem/SockMsg.pm @@ -159,6 +159,8 @@ INFO } elsif ( $self->{'connect_now'} ) { +#print "NOW\n" ; + $self->connect() ; } @@ -235,6 +237,8 @@ INFO TraceStatus "\n$info" ; +#print "\n$info" ; + if ( my $log_name = $self->{ 'log_name' } ) { #print "MSG LOG\n" ; @@ -264,6 +268,7 @@ sub triggered_cell { 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'} ; diff --git a/notes/srs_notes.txt b/notes/srs_notes.txt new file mode 100644 index 0000000..7b3e6c3 --- /dev/null +++ b/notes/srs_notes.txt @@ -0,0 +1,6 @@ +Odd sort of behavior... when dumping \%:: with Data::Dumper in Stem/Conf.pm +(insert a print @ line 234) + +the program just "freezes"... + + diff --git a/t/config/test_stem_bug.pl b/t/config/test_stem_bug.pl new file mode 100644 index 0000000..5f90534 --- /dev/null +++ b/t/config/test_stem_bug.pl @@ -0,0 +1,22 @@ +#!/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" } + + diff --git a/t/event/event_test.pl b/t/event/event_test.pl index 4f54906..1615ff8 100644 --- a/t/event/event_test.pl +++ b/t/event/event_test.pl @@ -63,7 +63,12 @@ sub triggered { 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 { @@ -75,6 +80,22 @@ 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', @@ -84,14 +105,10 @@ sub test_signal_events { $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 @@ -141,7 +158,13 @@ sub hard_timeout { 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 ) {