[urisagit/Stem.git] / BuildStem.pm

package BuildStem ;

use strict;
use warnings qw( all );

use Carp ;
use Config;
use File::Path ;
use File::Spec ;

use lib 'lib' ;
use base 'Module::Build' ;

$ENV{HARNESS_DEBUG} = 1 ;
$ENV{HARNESS_VERBOSE} = 1 ;

# this is the common env values to control running stem stuff in the
# build directory.

my $env =
	'PATH=blib/bin:blib/demo:$PATH PERL5LIB=blib/lib STEM_CONF_PATH=conf' ;

my %env = (
	PATH	=> "blib/bin:blib/demo:$ENV{PATH}",
	PERL5LIB => 'blib/lib',
	STEM_CONF_PATH	=> 'conf',
) ;

local( @ENV{ keys %env } ) = values %env ;


my ( @manifest_lines ) ;

eval {
	require Stem::InstallConfig
} ;
my $conf = \%Stem::InstallConfig::Config ;

my $is_win32 = ( $^O =~ /Win32/) ? 1 : 0 ;

my $default_stem_path = $is_win32 ?
		'/stem' :
		File::Spec->catfile(
			File::Spec->rootdir, qw( usr local stem ) ) ;

my $default_conf_path = File::Spec->catfile( $default_stem_path, 'conf' ) ;
#my $default_tail_dir = File::Spec->catfile( File::Spec->tmpdir, 'stem_tail' );

my %defaults = (
	bin_path	=> $Config{bin},
	run_stem_path	=> File::Spec->catfile( $Config{bin}, 'run_stem' ),
	perl_path	=> $Config{perlpath},
	conf_path	=> $default_conf_path,
	prefix		=> $Config{prefix},
#	tail_dir	=> $default_tail_dir,
	build_demos 	=> ! $is_win32,
	install_demos	=> ! $is_win32,
	install_ssfe	=> ! $is_win32,
	%{$conf}
);

################
# these are the top level action handlers. ACTION_foo gets called when you do
# 'Build foo' on the command line
################

sub ACTION_build {

	my ( $self ) = @_ ;

	$self->query_for_config() ;

	$self->SUPER::ACTION_build() ;

#	$self->build_bin() ;
}

sub ACTION_test {

	my ( $self ) = @_ ;

	local( @ENV{ keys %env } ) = values %env ;

	$self->depends_on('build');

	$self->SUPER::ACTION_test() ;
}

sub ACTION_install {

	my ( $self ) = @_ ;

	$self->install_config_files() ;
#	$self->install_ssfe() ;

	$self->SUPER::ACTION_install() ;
}

sub ACTION_run { 

	my ( $self ) = @_ ;

	$self->depends_on('build');

	my $run_cmd = $self->{'args'}{'cmd'} || '' ;

	$run_cmd or die "Missing cmd=name argument" ;

	my $cmd = "$env $run_cmd" ;
#	print "CMD: $cmd\n" ;

	system $cmd ;
}

sub ACTION_run_stem { 

	my ( $self ) = @_ ;

	$self->depends_on('build');

	my $conf = $self->{'args'}{'conf'} || '' ;

	$conf or die "Missing conf=name argument" ;

	my $cmd = "$env run_stem $conf" ;
#	print "DEMO: $cmd\n" ;

	system $cmd ;
}


sub run_demo { 

	my ( $self ) = @_ ;

	$self->depends_on('build');

	my $cmd = "$env $self->{action}_demo" ;
	print "DEMO: $cmd\n" ;
	system $cmd ;
}


sub ACTION_tail {

	mkdir 'tail' ;
	
	unlink <tail/*> ;

	goto &run_demo ;
}

*ACTION_chat = \&run_demo ;
*ACTION_chat2 = \&run_demo ;
*ACTION_inetd = \&run_demo ;

sub ACTION_update_pod {

	my( $self ) = @_ ;

	my @manifest_sublist = $self->grep_manifest( qr/\.pm$/ ) ;

	@manifest_sublist = grep /Codec/, @manifest_sublist ;

print join( "\n", @manifest_sublist ), "\n" ;
	
	system( "bin/spec2pod.pl @manifest_sublist" ) ;

	return;
}

# grep through all matched files
# command line args:
#	files=<regex> (default is all .pm files)
#	re=<regex>

sub ACTION_grep {

	my( $self ) = @_ ;

	my $args = $self->{'args'} ;

	my $file_regex = $args->{ files } || qr/\.pm$/ ;
	my $grep_regex = $args->{ re } or die "need grep regex" ; 

	my @manifest_sublist = $self->grep_manifest( $file_regex ) ;

	local( @ARGV ) = @manifest_sublist ;

	while( <> ) {

		next unless /$grep_regex/ ;

		print "$ARGV:$. $_"
	}
	continue {

		close ARGV if eof ;
	}

	return;
}

# ACTION: grep through MANIFEST
# command line args:
#	files=<regex>
#
# do we need this action?
# 

sub ACTION_grep_manifest {

	my( $self ) = @_ ;

	my @manifest_sublist = $self->grep_manifest() ;

	print join( "\n", @manifest_sublist ), "\n" ;
	return;
}

# ACTION: count source lines
# command line args:
#	files=<regex> (defaults to all .pm and bin files
#
# do we need this action?

sub ACTION_lines {

	my( $self ) = @_ ;

	my $args = $self->{'args'} ;
	my $file_regex = $args->{ files } || qr/\.pm$|^bin/ ;

	my @manifest_sublist = $self->grep_manifest( $file_regex ) ;

	system( "./util/lines @manifest_sublist" ) ;

	return;
}

# build a distro and scp to stemsystems.com

sub ACTION_ftp {

	my ( $self ) = @_ ;

	my $dist_tar = $self->dist_dir() . '.tar.gz' ;

	unlink $dist_tar ;

	$self->ACTION_dist() ;

	system "scp $dist_tar stemsystems.com:www/" ;
}


# this sub overrides the find_test_files method in Module::Build

sub find_test_files {

	my ($self) = @_;

	my $test_args = $self->{ args }{ tests } ;

	my @tests = $test_args ? split( ':', $test_args ) :
 		    $self->grep_manifest( qr/\.t$/ ) ;

	return \@tests ;
}

sub process_script_files {
	my( $self ) = @_ ;

	my @scripts = $self->grep_manifest( qr{^bin/} ) ;

#print "SCR @scripts\n" ;
	foreach my $file ( @scripts ) {

		my $bin_dir = File::Spec->catdir(
				$self->blib,
				$file =~ /_demo$/ ? 'demo' : 'bin' ) ;

		File::Path::mkpath( $bin_dir );
  
		my $result = $self->copy_if_modified(
			$file, $bin_dir, 'flatten') or next;

#print "COPY $file\n" ;
		$self->fix_run_stem($result);
		$self->fix_demos($result);
		$self->fix_shebang_line($result);
		$self->make_executable($result);
	}
}

sub fix_run_stem {

	my( $self, $file ) = @_ ;

	return unless $file =~ m{/run_stem$} ;

	my $text = read_file( $file ) ;

	$text =~ s/'conf:.'/'$conf->{'conf_path'}'/ if $conf->{'conf_path'} ;

	write_file( $file, $text ) ;
}

sub fix_demos {

	my( $self, $file ) = @_ ;

	return unless $file =~ /_demo$/ ;

	my $text = read_file( $file ) ;

	$conf->{xterm_path} ||= 'NOT FOUND' ;
	$conf->{telnet_path} ||= 'NOT FOUND' ;

	$text =~ s[xterm][$conf->{xterm_path}]g;
	$text =~ s[telnet][$conf->{telnet_path}]g;

	write_file( $file, $text ) ;
}

# MANIFEST helper subs

sub grep_manifest {

	my( $self, $file_regex ) = @_ ;

	$file_regex ||= $self->{ args }{ files } || qr/.*/ ;

	manifest_load() ;

	return grep( /$file_regex/, @manifest_lines ) ;
}

sub manifest_load {

	return if @manifest_lines ;

	@manifest_lines = grep ! /^\s*$|^\s*#/, read_file( 'MANIFEST' ) ;

	chomp @manifest_lines ;

	return ;
}

#################################

sub query_for_config {

	my( $self ) = @_ ;

	return if $defaults{ 'config_done' } ;

	print <<'EOT';

Building Stem

This script will ask you various questions in order to properly
configure, build and install Stem on your system.  Whenever a question
is asked, the default answer will be shown inside [brackets].
Pressing enter will accept the default answer. If a choice needs to be
made from a list of values, that list will be inside (parentheses).

If you have already configured Stem in a previous build, you can put
use_defaults=1 on the Build command line and you won't be prompted for
any answers and the previous settings will be used.

If you want to force a new build, run Build clean.

EOT

	$self->get_path_config() ;
	$self->get_demo_config() ;

	$defaults{ 'config_done' } = 1 ;

	$self->write_config_pm() ;
}


my $package = 'Stem::InstallConfig' ;

sub config_pm_path {

	return File::Spec->catfile(
		File::Spec->curdir, 'lib', split( /::/, $package) ) . '.pm' ;

}

sub write_config_pm {

	my ( $self ) = @_ ;

	my $config = Data::Dumper->Dump(
		[\%defaults],
		["*${package}::Config"]
	);

	my $conf_pm_file = $self->config_pm_path() ;

	$self->add_to_cleanup( $conf_pm_file ) ;

	write_file( $conf_pm_file, <<EOT ) ;

# DO NOT EDIT
# this file is generated by running Build build

package $package ;

$config
1 ;
EOT

}


sub get_path_config {

	my( $self ) = @_ ;

# 	$self->query_config_value( <<'EOT', 'perl_path' );

# Stem has several executable Perl programs and demonstration scripts
# and they need to have the correct path to your perl binary.

# What is the path to perl?
# EOT

# 	$self->query_config_value( <<'EOT', 'bin_path' );

# Those Stem executables need to be installed in a directory that is in your
# shell $PATH variable.

# What directory will have the Stem executables?
# EOT

 	$self->query_config_value( <<'EOT', 'conf_path' );

Stem configuration files are used to create and initialize Stem Cells
(objects). Stem needs to know the list of directories to search to
find its configurations files.

Note that the default has a single absolute path. You can test Stem
configurations easily setting this path when executing run_stem. You
can override or modify the path time with either a shell environment
variable or on the command line of run_stem. See the documentation on
run_stem for how so do this.

The first directory in the list is where the standard Stem
configuration files will be installed.

Enter a list of absolute directory paths separated by ':'.

What directories do you want to search for Stem configuration files?
EOT

	return ;
}

sub get_demo_config {

	my( $self ) = @_ ;

# don't even bother if win32

	return if $is_win32 ;

# 	$self->get_config_boolean( <<'EOT', 'build_demos' );

# Stem comes with several demonstration scripts. After building them,
# they can be run from the main directory by the Build script: ./Build
# chat, Build inetd, etc.  Do you want to build the demos?
# EOT

# 	return unless $defaults{build_demos};

# all the demos need xterm

	$self->get_xterm_path();
	$self->get_telnet_path();
	return unless -x $defaults{xterm_path} && -x $defaults{telnet_path};

# 	$self->query_config_value( <<'EOT', 'tail_dir' );

# The tail demo script needs a temporary working directory.  Enter the
# path to a directory to use for this purpose.  If it does not exist,
# this directory will be created.
# EOT

	$self->get_config_boolean( <<'EOT', 'install_ssfe' );

ssfe (Split Screen Front End) is a compiled program optionally used by
the Stem demonstration scripts that provides a full screen interface
with command line editing and history. It is not required to run Stem
but it makes the demonstrations easier to work with and they look much
nicer. To use ssfe add the '-s' option when you run any demonstration
script. You can also use ssfe for your own programs.  Install ssfe in
some place in your \$PATH ($conf->{'bin_path'} is where Stem executables
are being installed) so it can be used by the demo scripts. The ssfe
install script will do this for you or you can do it manually after
building it.

Do you want to install ssfe?
EOT

}

sub get_xterm_path {

	my( $self ) = @_ ;

	my $xterm_path;

# 	unless ( $xterm_path = which_exec( 'xterm' ) ) {

# 		foreach my $path ( qw(
# 			/usr/openwin/bin/xterm
# 			/usr/bin/X11/xterm
# 			/usr/X11R6/bin/xterm ) ) {

# 			next unless -x $path;
# 			$xterm_path = $path ;
# 			last;
# 		}
# 	}

# 	if ( $xterm_path ) {

# 		$defaults{'xterm_path'} = $xterm_path ;
# 		print "xterm was found at '$xterm_path'\n";
# 		return ;
# 	}

	$self->query_config_value( <<"EOT", 'xterm_path' );

xterm was not found on this system. you can't run the demo programs
without xterm.  Make sure you enter a valid path to xterm or some other
terminal emulator.

NOTE: If you don't have an xterm, you can still run the demo scripts
by hand. Run a *_demo script and see what commands it issues. Take the
part after the -e and run that command in its own terminal window.

Enter the path to xterm (or another compatible terminal emulator)
EOT

}

sub get_telnet_path {

	my( $self ) = @_ ;

	my $telnet_path;

	unless ( $telnet_path = which_exec( 'telnet' ) ) {

# enter a list of common places to find telnet. or delete this as it
# will almost always be in the path

		foreach my $path ( qw( ) ) {

			next unless -x $path;
			$telnet_path = $path ;
			last;
		}
	}

	if ( $telnet_path ) {

		$defaults{'telnet_path'} = $telnet_path ;
		print "telnet was found at '$telnet_path'\n";
		return ;
	}

	$self->query_config_value( <<"EOT", 'telnet_path' );

telnet was not found on this system. you can't run the demo programs
without telnet.  Make sure you enter a valid path to telnet or some other
terminal emulator.

NOTE: If you don't have an telnet, you can still run the demo scripts
by hand. Run a *_demo script and see what telnet commands it
issues. The run those telnet commands using your telnet or another
similar program.

Enter the path to telnet (or another compatible terminal emulator)
EOT

}

sub install_config_files {

	my ( $self ) = @_ ;

	my ( $conf_path ) = split /:/, $conf->{conf_path} ;

	mkpath( $conf_path, 1, 0755 ) unless -d $conf_path ;

	my @config_files = $self->grep_manifest( qr{^conf/.+\.stem$} ) ;

	foreach my $conf_file (@config_files) {

		$conf_file =~ s{conf/}{} ;

		my $out_file = File::Spec->catfile( $conf_path, $conf_file );

		print "Installing config file: $out_file\n";

		my $in_file = File::Spec->catfile(
			    File::Spec->curdir(), 'conf', $conf_file );

		my $conf_text = read_file($in_file);

		if ( $conf_file eq 'inetd.stem' ) {

			my $quote_serve = File::Spec->catfile(
				$conf->{bin_path}, 'quote_serve' );

			$conf_text =~ s[path\s+=>\s+'bin/quote_serve',]
				       [path\t\t=> '$quote_serve',];
		}
# 		elsif ( $conf eq 'monitor.stem' || $conf eq 'archive.stem' ) {

# 			$conf_text =~ s[path'\s+=>\s+'tail]
# 				       [path'\t\t=> '$conf->{tail_dir}]g ;
# 		}

		write_file( $out_file, $conf_text );
	}
}


sub install_ssfe {

	my ( $self ) = @_ ;

	return unless $conf->{install_stem_demos} &&
		      $conf->{install_ssfe} ;

	print <<'EOT';

Installing ssfe.

This is not a Stem install script and it will ask its own
questions. It will execute in its own xterm (whatever was configured
earlier) to keep this install's output clean. The xterm is kept open
with a long sleep call and can be exited by typing ^C.

EOT

#########
# UGLY
#########

    system <<'EOT';
xterm -e /bin/sh -c 'chdir extras ;
tar zxvf sirc-2.211.tar.gz ;
chdir sirc-2.211 ;
./install ;
sleep 1000 ;'
EOT

    print "\nInstallation of ssfe is done\n\n";
}

#########################################################
# this sub builds the exec scripts in bin and puts them into blib/bin
# for local running or later installation

# sub build_bin {

# 	my ( $self ) = @_ ;

# 	my @bin_scripts = $self->grep_manifest( qr{^bin/} ) ;

# 	foreach my $bin_file ( @bin_scripts ) {

# #print "BIN $bin_file\n" ;

# 		my $bin_text = read_file( $bin_file ) ;

# 		$bin_file =~ s{bin/}{} ;

# # fix the shebang line

# 		$bin_text =~ s{/usr/local/bin/perl}{$conf->{'perl_path'}} ;

# 		my $bin_dir ;

# 		if ( $bin_file =~ /_demo$/ ) {

# 			next unless $conf->{build_demos} ;

# 			$bin_dir = 'demo' ;

# # fix the location of xterms in the demo scripts

# 			$bin_text =~ s[xterm][$conf->{xterm_path}]g;
# 			$bin_text =~ s[telnet][$conf->{telnet_path}]g;

# # fix the default config search path in run_stem
# 		}
# 		else {

# 			$bin_dir = 'bin' ;

# # fix the default config search path in run_stem

# 			if ( $bin_file eq 'run_stem' ) {
# 				$bin_text =~
# 					s/'conf:.'/'$conf->{'conf_path'}'/ ;
# 			}
# 		}

# # 		elsif ( $bin_file eq 'tail_demo' ) {
# # 			$bin_text =~ s['tail']['$conf->{tail_dir}'];
# # 		}

# # write the built script into the blib/ dir

# 		my $out_file = File::Spec->catfile( 'blib',
# 						    $bin_dir,
# 						    $bin_file
# 		);

# 		mkdir "blib/$bin_dir" ;
# 		print "Building executable script: $out_file\n";
# 		write_file( $out_file, $bin_text );
# 		chmod 0755, $out_file;
# 	}
# }

#############################################################

# this sub searches the path for the locations of an executable

sub which_exec {

	my ( $exec ) = @_;

	foreach my $path_dir ( split /[:;]/, $ENV{PATH} ) {

		my $exec_path = File::Spec->catfile( $path_dir, $exec );
		return $exec_path if -x $exec_path ;
	}

	return;
}

# the sub searches a list of dir paths to find the first one that
# exists with a prefix dir

# UNUSED FOR THE MOMENT

# sub which_dir {

# 	my ( $prefix, @dirs ) = @_;

# 	foreach my $subdir ( @dirs ) {

# 		my $dir = File::Spec->catfile( $prefix, $subdir );
# 		return $dir if -x $dir;
# 	}

# 	return;
# }

#############################################################

# these subs handle querying for a user answer. it uses the key to
# find a current value in the defaults and prompt for another value
# if 'use_defaults' is set on the command line, then no prompting will be done

sub query_config_value {

	my( $self, $query, $key ) = @_ ;

	my $default = $self->{args}{$key} ;

	$default = $defaults{ $key } unless defined $default ;

	$defaults{ $key } = ( $self->{args}{use_defaults} ) ?
		$default :
		$self->prompt( edit_query( $query, $default ), $default ) ;
}

sub get_config_boolean {

	my( $self, $query, $key ) = @_ ;

	my $default = $self->{args}{$key} ;

	$default = $defaults{ $key } unless defined $default ;
	$default =~ tr/01/ny/ ;

	$defaults{ $key } = ( $self->{args}{use_defaults} ) ?
		$default :
		$self->y_n( edit_query( $query, $default ), $default ) ;
}

sub edit_query {

	my ( $query, $default ) = @_ ;

	chomp $query ;

	$default ||= '' ;

	my $last_line = (split /\n/, $query)[-1] ;

	if ( length( $last_line ) + 2 * length( $default ) > 70 ) {

		$query .= "\n\t" ;
	}

	return $query ;
}

# low level file i/o subs. should be replaced with File::Slurp. stem
# should depend on it


sub read_file {

	my ( $file_name ) = @_ ;

	local( *FH );

	open( FH, $file_name ) || croak "Can't open $file_name $!";

	return <FH> if wantarray;

	read FH, my $buf, -s FH;
	return $buf;
}

sub write_file {

	my( $file_name ) = shift ;

	local( *FH ) ;

	open( FH, ">$file_name" ) || croak "can't create $file_name $!" ;

	print FH @_ ;
}

1 ;
Commit	Line	Data
4536f655	1	package BuildStem ;
	2
	3	use strict;
	4	use warnings qw( all );
	5
	6	use Carp ;
	7	use Config;
	8	use File::Path ;
	9	use File::Spec ;
	10
	11	use lib 'lib' ;
	12	use base 'Module::Build' ;
	13
	14	$ENV{HARNESS_DEBUG} = 1 ;
	15	$ENV{HARNESS_VERBOSE} = 1 ;
	16
	17	# this is the common env values to control running stem stuff in the
	18	# build directory.
	19
	20	my $env =
	21	'PATH=blib/bin:blib/demo:$PATH PERL5LIB=blib/lib STEM_CONF_PATH=conf' ;
	22
	23	my %env = (
	24	PATH => "blib/bin:blib/demo:$ENV{PATH}",
	25	PERL5LIB => 'blib/lib',
	26	STEM_CONF_PATH => 'conf',
	27	) ;
	28
	29	local( @ENV{ keys %env } ) = values %env ;
	30
	31
	32	my ( @manifest_lines ) ;
	33
	34	eval {
	35	require Stem::InstallConfig
	36	} ;
	37	my $conf = \%Stem::InstallConfig::Config ;
	38
	39	my $is_win32 = ( $^O =~ /Win32/) ? 1 : 0 ;
	40
	41	my $default_stem_path = $is_win32 ?
	42	'/stem' :
	43	File::Spec->catfile(
	44	File::Spec->rootdir, qw( usr local stem ) ) ;
	45
	46	my $default_conf_path = File::Spec->catfile( $default_stem_path, 'conf' ) ;
	47	#my $default_tail_dir = File::Spec->catfile( File::Spec->tmpdir, 'stem_tail' );
	48
	49	my %defaults = (
	50	bin_path => $Config{bin},
	51	run_stem_path => File::Spec->catfile( $Config{bin}, 'run_stem' ),
	52	perl_path => $Config{perlpath},
	53	conf_path => $default_conf_path,
	54	prefix => $Config{prefix},
	55	# tail_dir => $default_tail_dir,
	56	build_demos => ! $is_win32,
	57	install_demos => ! $is_win32,
	58	install_ssfe => ! $is_win32,
	59	%{$conf}
	60	);
	61
	62	################
	63	# these are the top level action handlers. ACTION_foo gets called when you do
	64	# 'Build foo' on the command line
65	################
66
67	sub ACTION_build {
68
69	my ( $self ) = @_ ;
70
71	$self->query_for_config() ;
72
73	$self->SUPER::ACTION_build() ;
74
75	# $self->build_bin() ;
76	}
77
78	sub ACTION_test {
79
80	my ( $self ) = @_ ;
81
82	local( @ENV{ keys %env } ) = values %env ;
83
84	$self->depends_on('build');
85
86	$self->SUPER::ACTION_test() ;
87	}
88
89	sub ACTION_install {
90
91	my ( $self ) = @_ ;
92
93	$self->install_config_files() ;
94	# $self->install_ssfe() ;
95
96	$self->SUPER::ACTION_install() ;
97	}
98
99	sub ACTION_run {
100
101	my ( $self ) = @_ ;
102
103	$self->depends_on('build');
104
105	my $run_cmd = $self->{'args'}{'cmd'} \|\| '' ;
106
107	$run_cmd or die "Missing cmd=name argument" ;
108
109	my $cmd = "$env $run_cmd" ;
110	# print "CMD: $cmd\n" ;
111
112	system $cmd ;
113	}
114
115	sub ACTION_run_stem {
116
117	my ( $self ) = @_ ;
118
119	$self->depends_on('build');
120
121	my $conf = $self->{'args'}{'conf'} \|\| '' ;
122
123	$conf or die "Missing conf=name argument" ;
124
125	my $cmd = "$env run_stem $conf" ;
126	# print "DEMO: $cmd\n" ;
127
128	system $cmd ;
129	}
130
131
132	sub run_demo {
133
134	my ( $self ) = @_ ;
135
136	$self->depends_on('build');
137
138	my $cmd = "$env $self->{action}_demo" ;
139	print "DEMO: $cmd\n" ;
140	system $cmd ;
141	}
142
143
144	sub ACTION_tail {
145
146	mkdir 'tail' ;
147
148	unlink <tail/*> ;
149
150	goto &run_demo ;
151	}
152
153	*ACTION_chat = \&run_demo ;
154	*ACTION_chat2 = \&run_demo ;
155	*ACTION_inetd = \&run_demo ;
156
157	sub ACTION_update_pod {
158
159	my( $self ) = @_ ;
160
161	my @manifest_sublist = $self->grep_manifest( qr/\.pm$/ ) ;
162
163	@manifest_sublist = grep /Codec/, @manifest_sublist ;
164
165	print join( "\n", @manifest_sublist ), "\n" ;
166
167	system( "bin/spec2pod.pl @manifest_sublist" ) ;
168
169	return;
170	}
171
172	# grep through all matched files
173	# command line args:
174	# files=<regex> (default is all .pm files)
175	# re=<regex>
176
177	sub ACTION_grep {
178
179	my( $self ) = @_ ;
180
181	my $args = $self->{'args'} ;
182
183	my $file_regex = $args->{ files } \|\| qr/\.pm$/ ;
184	my $grep_regex = $args->{ re } or die "need grep regex" ;
185
186	my @manifest_sublist = $self->grep_manifest( $file_regex ) ;
187
188	local( @ARGV ) = @manifest_sublist ;
189
190	while( <> ) {
191
192	next unless /$grep_regex/ ;
193
194	print "$ARGV:$. $_"
195	}
196	continue {
197
198	close ARGV if eof ;
199	}
200
201	return;
202	}
203
204	# ACTION: grep through MANIFEST
205	# command line args:
206	# files=<regex>
207	#
208	# do we need this action?
209	#
210
211	sub ACTION_grep_manifest {
212
213	my( $self ) = @_ ;
214
215	my @manifest_sublist = $self->grep_manifest() ;
216
217	print join( "\n", @manifest_sublist ), "\n" ;
218	return;
219	}
220
221	# ACTION: count source lines
222	# command line args:
223	# files=<regex> (defaults to all .pm and bin files
224	#
225	# do we need this action?
226
227	sub ACTION_lines {
228
229	my( $self ) = @_ ;
230
231	my $args = $self->{'args'} ;
232	my $file_regex = $args->{ files } \|\| qr/\.pm$\|^bin/ ;
233
234	my @manifest_sublist = $self->grep_manifest( $file_regex ) ;
235
236	system( "./util/lines @manifest_sublist" ) ;
237
238	return;
239	}
240
241	# build a distro and scp to stemsystems.com
242
243	sub ACTION_ftp {
244
245	my ( $self ) = @_ ;
246
247	my $dist_tar = $self->dist_dir() . '.tar.gz' ;
248
249	unlink $dist_tar ;
250
251	$self->ACTION_dist() ;
252
253	system "scp $dist_tar stemsystems.com:www/" ;
254	}
255
256
257	# this sub overrides the find_test_files method in Module::Build
258
259	sub find_test_files {
260
261	my ($self) = @_;
262
263	my $test_args = $self->{ args }{ tests } ;
264
265	my @tests = $test_args ? split( ':', $test_args ) :
266	$self->grep_manifest( qr/\.t$/ ) ;
267
268	return \@tests ;
269	}
270
271	sub process_script_files {
272	my( $self ) = @_ ;
273
274	my @scripts = $self->grep_manifest( qr{^bin/} ) ;
275
276	#print "SCR @scripts\n" ;
277	foreach my $file ( @scripts ) {
278
279	my $bin_dir = File::Spec->catdir(
280	$self->blib,
281	$file =~ /_demo$/ ? 'demo' : 'bin' ) ;
282
283	File::Path::mkpath( $bin_dir );
284
285	my $result = $self->copy_if_modified(
286	$file, $bin_dir, 'flatten') or next;
287
288	#print "COPY $file\n" ;
289	$self->fix_run_stem($result);
290	$self->fix_demos($result);
291	$self->fix_shebang_line($result);
292	$self->make_executable($result);
293	}
294	}
295
296	sub fix_run_stem {
297
298	my( $self, $file ) = @_ ;
299
300	return unless $file =~ m{/run_stem$} ;
301
302	my $text = read_file( $file ) ;
303
304	$text =~ s/'conf:.'/'$conf->{'conf_path'}'/ if $conf->{'conf_path'} ;
305
306	write_file( $file, $text ) ;
307	}
308
309	sub fix_demos {
310
311	my( $self, $file ) = @_ ;
312
313	return unless $file =~ /_demo$/ ;
314
315	my $text = read_file( $file ) ;
316
317	$conf->{xterm_path} \|\|= 'NOT FOUND' ;
318	$conf->{telnet_path} \|\|= 'NOT FOUND' ;
319
320	$text =~ s[xterm][$conf->{xterm_path}]g;
321	$text =~ s[telnet][$conf->{telnet_path}]g;
322
323	write_file( $file, $text ) ;
324	}
325
326	# MANIFEST helper subs
327
328	sub grep_manifest {
329
330	my( $self, $file_regex ) = @_ ;
331
332	$file_regex \|\|= $self->{ args }{ files } \|\| qr/.*/ ;
333
334	manifest_load() ;
335
336	return grep( /$file_regex/, @manifest_lines ) ;
337	}
338
339	sub manifest_load {
340
341	return if @manifest_lines ;
342
343	@manifest_lines = grep ! /^\s$\|^\s#/, read_file( 'MANIFEST' ) ;
344
345	chomp @manifest_lines ;
346
347	return ;
348	}
349
350	#################################
351
352	sub query_for_config {
353
354	my( $self ) = @_ ;
355
356	return if $defaults{ 'config_done' } ;
357
358	print <<'EOT';
359
360	Building Stem
361
362	This script will ask you various questions in order to properly
363	configure, build and install Stem on your system. Whenever a question
364	is asked, the default answer will be shown inside [brackets].
365	Pressing enter will accept the default answer. If a choice needs to be
366	made from a list of values, that list will be inside (parentheses).
367
368	If you have already configured Stem in a previous build, you can put
369	use_defaults=1 on the Build command line and you won't be prompted for
370	any answers and the previous settings will be used.
371
372	If you want to force a new build, run Build clean.
373
374	EOT
375
376	$self->get_path_config() ;
377	$self->get_demo_config() ;
378
379	$defaults{ 'config_done' } = 1 ;
380
381	$self->write_config_pm() ;
382	}
383
384
385	my $package = 'Stem::InstallConfig' ;
386
387	sub config_pm_path {
388
389	return File::Spec->catfile(
390	File::Spec->curdir, 'lib', split( /::/, $package) ) . '.pm' ;
391
392	}
393
394	sub write_config_pm {
395
396	my ( $self ) = @_ ;
397
398	my $config = Data::Dumper->Dump(
399	[\%defaults],
400	["*${package}::Config"]
401	);
402
403	my $conf_pm_file = $self->config_pm_path() ;
404
405	$self->add_to_cleanup( $conf_pm_file ) ;
406
407	write_file( $conf_pm_file, <<EOT ) ;
408
409	# DO NOT EDIT
410	# this file is generated by running Build build
411
412	package $package ;
413
414	$config
415	1 ;
416	EOT
417
418	}
419
420
421	sub get_path_config {
422
423	my( $self ) = @_ ;
424
425	# $self->query_config_value( <<'EOT', 'perl_path' );
426
427	# Stem has several executable Perl programs and demonstration scripts
428	# and they need to have the correct path to your perl binary.
429
430	# What is the path to perl?
431	# EOT
432
433	# $self->query_config_value( <<'EOT', 'bin_path' );
434
435	# Those Stem executables need to be installed in a directory that is in your
436	# shell $PATH variable.
437
438	# What directory will have the Stem executables?
439	# EOT
440
441	$self->query_config_value( <<'EOT', 'conf_path' );
442
443	Stem configuration files are used to create and initialize Stem Cells
444	(objects). Stem needs to know the list of directories to search to
445	find its configurations files.
446
447	Note that the default has a single absolute path. You can test Stem
448	configurations easily setting this path when executing run_stem. You
449	can override or modify the path time with either a shell environment
450	variable or on the command line of run_stem. See the documentation on
451	run_stem for how so do this.
452
453	The first directory in the list is where the standard Stem
454	configuration files will be installed.
455
456	Enter a list of absolute directory paths separated by ':'.
457
458	What directories do you want to search for Stem configuration files?
459	EOT
460
461	return ;
462	}
463
464	sub get_demo_config {
465
466	my( $self ) = @_ ;
467
468	# don't even bother if win32
469
470	return if $is_win32 ;
471
472	# $self->get_config_boolean( <<'EOT', 'build_demos' );
473
474	# Stem comes with several demonstration scripts. After building them,
475	# they can be run from the main directory by the Build script: ./Build
476	# chat, Build inetd, etc. Do you want to build the demos?
477	# EOT
478
479	# return unless $defaults{build_demos};
480
481	# all the demos need xterm
482
483	$self->get_xterm_path();
484	$self->get_telnet_path();
485	return unless -x $defaults{xterm_path} && -x $defaults{telnet_path};
486
487	# $self->query_config_value( <<'EOT', 'tail_dir' );
488
489	# The tail demo script needs a temporary working directory. Enter the
490	# path to a directory to use for this purpose. If it does not exist,
491	# this directory will be created.
492	# EOT
493
494	$self->get_config_boolean( <<'EOT', 'install_ssfe' );
495
496	ssfe (Split Screen Front End) is a compiled program optionally used by
497	the Stem demonstration scripts that provides a full screen interface
498	with command line editing and history. It is not required to run Stem
499	but it makes the demonstrations easier to work with and they look much
500	nicer. To use ssfe add the '-s' option when you run any demonstration
501	script. You can also use ssfe for your own programs. Install ssfe in
502	some place in your \$PATH ($conf->{'bin_path'} is where Stem executables
503	are being installed) so it can be used by the demo scripts. The ssfe
504	install script will do this for you or you can do it manually after
505	building it.
506
507	Do you want to install ssfe?
508	EOT
509
510	}
511
512	sub get_xterm_path {
513
514	my( $self ) = @_ ;
515
516	my $xterm_path;
517
518	# unless ( $xterm_path = which_exec( 'xterm' ) ) {
519
520	# foreach my $path ( qw(
521	# /usr/openwin/bin/xterm
522	# /usr/bin/X11/xterm
523	# /usr/X11R6/bin/xterm ) ) {
524
525	# next unless -x $path;
526	# $xterm_path = $path ;
527	# last;
528	# }
529	# }
530
531	# if ( $xterm_path ) {
532
533	# $defaults{'xterm_path'} = $xterm_path ;
534	# print "xterm was found at '$xterm_path'\n";
535	# return ;
536	# }
537
538	$self->query_config_value( <<"EOT", 'xterm_path' );
539
540	xterm was not found on this system. you can't run the demo programs
541	without xterm. Make sure you enter a valid path to xterm or some other
542	terminal emulator.
543
544	NOTE: If you don't have an xterm, you can still run the demo scripts
545	by hand. Run a *_demo script and see what commands it issues. Take the
546	part after the -e and run that command in its own terminal window.
547
548	Enter the path to xterm (or another compatible terminal emulator)
549	EOT
550
551	}
552
553	sub get_telnet_path {
554
555	my( $self ) = @_ ;
556
557	my $telnet_path;
558
559	unless ( $telnet_path = which_exec( 'telnet' ) ) {
560
561	# enter a list of common places to find telnet. or delete this as it
562	# will almost always be in the path
563
564	foreach my $path ( qw( ) ) {
565
566	next unless -x $path;
567	$telnet_path = $path ;
568	last;
569	}
570	}
571
572	if ( $telnet_path ) {
573
574	$defaults{'telnet_path'} = $telnet_path ;
575	print "telnet was found at '$telnet_path'\n";
576	return ;
577	}
578
579	$self->query_config_value( <<"EOT", 'telnet_path' );
580
581	telnet was not found on this system. you can't run the demo programs
582	without telnet. Make sure you enter a valid path to telnet or some other
583	terminal emulator.
584
585	NOTE: If you don't have an telnet, you can still run the demo scripts
586	by hand. Run a *_demo script and see what telnet commands it
587	issues. The run those telnet commands using your telnet or another
588	similar program.
589
590	Enter the path to telnet (or another compatible terminal emulator)
591	EOT
592
593	}
594
595	sub install_config_files {
596
597	my ( $self ) = @_ ;
598
599	my ( $conf_path ) = split /:/, $conf->{conf_path} ;
600
601	mkpath( $conf_path, 1, 0755 ) unless -d $conf_path ;
602
603	my @config_files = $self->grep_manifest( qr{^conf/.+\.stem$} ) ;
604
605	foreach my $conf_file (@config_files) {
606
607	$conf_file =~ s{conf/}{} ;
608
609	my $out_file = File::Spec->catfile( $conf_path, $conf_file );
610
611	print "Installing config file: $out_file\n";
612
613	my $in_file = File::Spec->catfile(
614	File::Spec->curdir(), 'conf', $conf_file );
615
616	my $conf_text = read_file($in_file);
617
618	if ( $conf_file eq 'inetd.stem' ) {
619
620	my $quote_serve = File::Spec->catfile(
621	$conf->{bin_path}, 'quote_serve' );
622
623	$conf_text =~ s[path\s+=>\s+'bin/quote_serve',]
624	[path\t\t=> '$quote_serve',];
625	}
626	# elsif ( $conf eq 'monitor.stem' \|\| $conf eq 'archive.stem' ) {
627
628	# $conf_text =~ s[path'\s+=>\s+'tail]
629	# [path'\t\t=> '$conf->{tail_dir}]g ;
630	# }
631
632	write_file( $out_file, $conf_text );
633	}
634	}
635
636
637	sub install_ssfe {
638
639	my ( $self ) = @_ ;
640
641	return unless $conf->{install_stem_demos} &&
642	$conf->{install_ssfe} ;
643
644	print <<'EOT';
645
646	Installing ssfe.
647
648	This is not a Stem install script and it will ask its own
649	questions. It will execute in its own xterm (whatever was configured
650	earlier) to keep this install's output clean. The xterm is kept open
651	with a long sleep call and can be exited by typing ^C.
652
653	EOT
654
655	#########
656	# UGLY
657	#########
658
659	system <<'EOT';
660	xterm -e /bin/sh -c 'chdir extras ;
661	tar zxvf sirc-2.211.tar.gz ;
662	chdir sirc-2.211 ;
663	./install ;
664	sleep 1000 ;'
665	EOT
666
667	print "\nInstallation of ssfe is done\n\n";
668	}
669
670	#########################################################
671	# this sub builds the exec scripts in bin and puts them into blib/bin
672	# for local running or later installation
673
674	# sub build_bin {
675
676	# my ( $self ) = @_ ;
677
678	# my @bin_scripts = $self->grep_manifest( qr{^bin/} ) ;
679
680	# foreach my $bin_file ( @bin_scripts ) {
681
682	# #print "BIN $bin_file\n" ;
683
684	# my $bin_text = read_file( $bin_file ) ;
685
686	# $bin_file =~ s{bin/}{} ;
687
688	# # fix the shebang line
689
690	# $bin_text =~ s{/usr/local/bin/perl}{$conf->{'perl_path'}} ;
691
692	# my $bin_dir ;
693
694	# if ( $bin_file =~ /_demo$/ ) {
695
696	# next unless $conf->{build_demos} ;
697
698	# $bin_dir = 'demo' ;
699
700	# # fix the location of xterms in the demo scripts
701
702	# $bin_text =~ s[xterm][$conf->{xterm_path}]g;
703	# $bin_text =~ s[telnet][$conf->{telnet_path}]g;
704
705	# # fix the default config search path in run_stem
706	# }
707	# else {
708
709	# $bin_dir = 'bin' ;
710
711	# # fix the default config search path in run_stem
712
713	# if ( $bin_file eq 'run_stem' ) {
714	# $bin_text =~
715	# s/'conf:.'/'$conf->{'conf_path'}'/ ;
716	# }
717	# }
718
719	# # elsif ( $bin_file eq 'tail_demo' ) {
720	# # $bin_text =~ s['tail']['$conf->{tail_dir}'];
721	# # }
722
723	# # write the built script into the blib/ dir
724
725	# my $out_file = File::Spec->catfile( 'blib',
726	# $bin_dir,
727	# $bin_file
728	# );
729
730	# mkdir "blib/$bin_dir" ;
731	# print "Building executable script: $out_file\n";
732	# write_file( $out_file, $bin_text );
733	# chmod 0755, $out_file;
734	# }
735	# }
736
737	#############################################################
738
739	# this sub searches the path for the locations of an executable
740
741	sub which_exec {
742
743	my ( $exec ) = @_;
744
745	foreach my $path_dir ( split /[:;]/, $ENV{PATH} ) {
746
747	my $exec_path = File::Spec->catfile( $path_dir, $exec );
748	return $exec_path if -x $exec_path ;
749	}
750
751	return;
752	}
753
754	# the sub searches a list of dir paths to find the first one that
755	# exists with a prefix dir
756
757	# UNUSED FOR THE MOMENT
758
759	# sub which_dir {
760
761	# my ( $prefix, @dirs ) = @_;
762
763	# foreach my $subdir ( @dirs ) {
764
765	# my $dir = File::Spec->catfile( $prefix, $subdir );
766	# return $dir if -x $dir;
767	# }
768
769	# return;
770	# }
771
772	#############################################################
773
774	# these subs handle querying for a user answer. it uses the key to
775	# find a current value in the defaults and prompt for another value
776	# if 'use_defaults' is set on the command line, then no prompting will be done
777
778	sub query_config_value {
779
780	my( $self, $query, $key ) = @_ ;
781
782	my $default = $self->{args}{$key} ;
783
784	$default = $defaults{ $key } unless defined $default ;
785
786	$defaults{ $key } = ( $self->{args}{use_defaults} ) ?
787	$default :
788	$self->prompt( edit_query( $query, $default ), $default ) ;
789	}
790
791	sub get_config_boolean {
792
793	my( $self, $query, $key ) = @_ ;
794
795	my $default = $self->{args}{$key} ;
796
797	$default = $defaults{ $key } unless defined $default ;
798	$default =~ tr/01/ny/ ;
799
800	$defaults{ $key } = ( $self->{args}{use_defaults} ) ?
801	$default :
802	$self->y_n( edit_query( $query, $default ), $default ) ;
803	}
804
805	sub edit_query {
806
807	my ( $query, $default ) = @_ ;
808
809	chomp $query ;
810
811	$default \|\|= '' ;
812
813	my $last_line = (split /\n/, $query)[-1] ;
814
815	if ( length( $last_line ) + 2 * length( $default ) > 70 ) {
816
817	$query .= "\n\t" ;
818	}
819
820	return $query ;
821	}
822
823	# low level file i/o subs. should be replaced with File::Slurp. stem
824	# should depend on it
825
826
827	sub read_file {
828
829	my ( $file_name ) = @_ ;
830
831	local( *FH );
832
833	open( FH, $file_name ) \|\| croak "Can't open $file_name $!";
834
835	return <FH> if wantarray;
836
837	read FH, my $buf, -s FH;
838	return $buf;
839	}
840
841	sub write_file {
842
843	my( $file_name ) = shift ;
844
845	local( *FH ) ;
846
847	open( FH, ">$file_name" ) \|\| croak "can't create $file_name $!" ;
848
849	print FH @_ ;
850	}
851
852	1 ;