view release on metacpan or  search on metacpan

BuildStem.pm  view on Meta::CPAN

# 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 ;