package Outthentic::Story;
use strict;
use base 'Exporter';
use Outthentic::DSL;
use Outthentic::Story::Stat;
use File::ShareDir;
use JSON;
use Carp;
our @EXPORT = qw{
new_story end_of_story set_story story_cache_dir
get_prop set_prop
debug_mod1 debug_mod2 debug_mod12
set_stdout get_stdout stdout_file
dsl captures capture stream match_lines
run_story apply_story_vars story_var story_vars_pretty
do_perl_hook
do_ruby_hook
do_python_hook
do_bash_hook
ignore_story_err
project_root_dir
test_root_dir
host
dump_os
};
our @stories = ();
our $OS;
sub new_story {
my $self = {
ID => scalar(@stories),
props => {
ignore_story_err => 0 ,
dsl => Outthentic::DSL->new() ,
story_vars => {} },
};
push @stories, $self;
1;
}
sub end_of_story {
if (debug_mod12()){
main::note("end of story: ".(get_prop('story')));
}
delete $stories[-1];
}
sub set_story {
my $dist_lib_dir = File::ShareDir::dist_dir('Outthentic');
my $ruby_run_cmd;
if (-f project_root_dir()."/Gemfile" ){
$ruby_run_cmd = "cd ".project_root_dir()." && bundle exec ruby -I $dist_lib_dir -r outthentic -I ".story_cache_dir()
} else {
$ruby_run_cmd = "ruby -I $dist_lib_dir -r outthentic -I ".story_cache_dir();
}
my $python_run_cmd = "PYTHONPATH=\$PYTHONPATH:".(story_cache_dir()).":$dist_lib_dir python";
get_prop('dsl')->{languages}->{ruby} = $ruby_run_cmd;
get_prop('dsl')->{languages}->{python} = $python_run_cmd;
get_prop('dsl')->{cache_dir} = story_cache_dir();
my $bash_run_opts = "source "._bash_glue_file()." && source $dist_lib_dir/outthentic.bash";
get_prop('dsl')->{languages}->{ruby} = $ruby_run_cmd;
get_prop('dsl')->{languages}->{bash} = $bash_run_opts;
_make_cache_dir();
_mk_perl_glue_file();
_mk_ruby_glue_file();
_mk_python_glue_file();
_mk_bash_glue_file();
}
sub _story {
@stories[-1];
}
sub _story_id {
_story()->{ID};
}
sub get_prop {
my $name = shift;
_story()->{props}->{$name};
}
sub set_prop {
my $name = shift;
my $value = shift;
_story()->{props}->{$name} = $value;
}
sub project_root_dir {
get_prop('project_root_dir');
}
sub test_root_dir {
get_prop('test_root_dir');
}
sub host {
get_prop('host');
}
sub ignore_story_err {
my $val = shift;
my $rv;
if (defined $val){
set_prop('ignore_story_err',$val);
} else {
$rv = get_prop('ignore_story_err');
}
$rv;
}
sub debug_mod1 {
get_prop('debug') == 1
}
sub debug_mod2 {
get_prop('debug') == 2
}
sub debug_mod12 {
debug_mod1() or debug_mod2()
}
sub set_stdout {
my $line = shift;
open FSTDOUT, ">>", stdout_file() or die $!;
print FSTDOUT $line, "\n";
close FSTDOUT;
}
sub get_stdout {
return unless -f stdout_file();
my $data;
open FSTDOUT, stdout_file() or die $!;
my $data = join "", <FSTDOUT>;
close FSTDOUT;
$data;
}
sub stdout_file {
story_cache_dir()."/std.out"
}
sub _make_cache_dir {
my $cache_dir = test_root_dir()."/story-"._story_id();
if (debug_mod12()){
main::note("make cache dir: $cache_dir");
}
system("rm -rf $cache_dir");
system("mkdir -p $cache_dir");
}
sub story_cache_dir {
test_root_dir()."/story-"._story_id();
}
sub _perl_glue_file {
story_cache_dir()."/glue.pm";
}
sub _ruby_glue_file {
story_cache_dir()."/glue.rb";
}
sub _python_glue_file {
story_cache_dir()."/glue.py";
}
sub _bash_glue_file {
story_cache_dir()."/glue.bash";
}
sub dsl {
get_prop('dsl')
}
sub stream {
dsl()->stream
}
sub captures {
dsl()->{captures}
}
sub capture {
dsl()->{captures}->[0]
}
sub match_lines {
dsl()->{match_lines}
}
sub run_story {
my $path = shift;
my $story_vars = shift || {};
Outthentic::Story::Stat->new_story({
vars => $story_vars,
path => $path
});
my $test_root_dir = get_prop('test_root_dir');
my $project_root_dir = get_prop('project_root_dir');
my $story_module = "$test_root_dir/$project_root_dir/modules/$path/sparrow.pl";
die "story module file $story_module does not exist" unless -e $story_module;
if (debug_mod12()){
main::note("run downstream story: $path");
for my $k (keys %{$story_vars}){
my $v = $story_vars->{$k};
main::note("downstream story var: $k => $v");
}
}
{
package main;
unless (do $story_module) {
die "couldn't parse story module file $story_module: $@" if $@;
}
}
# return statistic for downstream story just executed
return Outthentic::Story::Stat->current;
}
sub do_perl_hook {
my $hook_file = shift;
{
package main;
unless (do $hook_file) {
die "couldn't parse perl hook file $hook_file: $@" if $@;
}
}
return 1;
}
sub _mk_perl_glue_file {
open PERL_GLUE, ">", _perl_glue_file() or confess "can't create perl glue file ".(_perl_glue_file())." : $!";
my $test_root_dir = test_root_dir();
my $story_dir = get_prop('story_dir');
my $project_root_dir = project_root_dir();
my $debug_mod12 = debug_mod12();
my $cache_dir = story_cache_dir;
my $os = _resolve_os();
print PERL_GLUE <<"CODE";
package glue;
1;
package main;
use strict;
sub debug_mod12 {
$debug_mod12
}
sub test_root_dir {
'$test_root_dir'
}
sub project_root_dir {
'$project_root_dir'
}
sub cache_dir {
'$cache_dir'
}
sub story_dir {
'$story_dir'
}
sub os { '$os' }
1;
CODE
close PERL_GLUE;
}
sub _mk_ruby_glue_file {
open RUBY_GLUE, ">", _ruby_glue_file() or die $!;
my $stdout_file = stdout_file();
my $test_root_dir = test_root_dir();
my $story_dir = get_prop('story_dir');
my $project_root_dir = project_root_dir();
my $debug_mod12 = debug_mod12();
my $cache_dir = story_cache_dir;
print RUBY_GLUE <<"CODE";
def debug_mod12
'$debug_mod12'
end
def test_root_dir
'$test_root_dir'
end
def project_root_dir
'$project_root_dir'
end
def cache_dir
'$cache_dir'
end
def story_dir
'$story_dir'
end
def stdout_file
'$stdout_file'
end
CODE
close RUBY_GLUE;
}
sub _mk_python_glue_file {
open PYTHON_GLUE, ">", _python_glue_file() or die $!;
my $stdout_file = stdout_file();
my $test_root_dir = test_root_dir();
my $story_dir = get_prop('story_dir');
my $project_root_dir = project_root_dir();
my $debug_mod12 = debug_mod12();
my $cache_dir = story_cache_dir;
print PYTHON_GLUE <<"CODE";
def debug_mod12():
return $debug_mod12
def test_root_dir():
return '$test_root_dir'
def project_root_dir():
return '$project_root_dir'
def cache_dir():
return '$cache_dir'
def story_dir():
return '$story_dir'
def stdout_file():
return '$stdout_file'
CODE
close PYTHON_GLUE;
}
sub _mk_bash_glue_file {
my $story_dir = get_prop('story_dir');
open BASH_GLUE, ">", _bash_glue_file() or die $!;
my $stdout_file = stdout_file();
my $test_root_dir = test_root_dir();
my $project_root_dir = project_root_dir();
my $debug_mod12 = debug_mod12();
my $cache_dir = story_cache_dir;
my $os = _resolve_os();
print BASH_GLUE <<"CODE";
debug_mod=debug_mod12
test_root_dir=$test_root_dir
project_root_dir=$project_root_dir
cache_dir=$cache_dir
story_dir=$story_dir
stdout_file=$stdout_file
os=$os
CODE
close BASH_GLUE;
}
sub do_ruby_hook {
my $file = shift;
my $ruby_lib_dir = File::ShareDir::dist_dir('Outthentic');
my $cmd;
if (-f project_root_dir()."/Gemfile" ){
$cmd = "cd ".project_root_dir()." && bundle exec ruby -I $ruby_lib_dir -r outthentic -I ".story_cache_dir()." $file"
} else {
$cmd = "ruby -I $ruby_lib_dir -r outthentic -I ".story_cache_dir()." $file"
}
if (debug_mod12()){
main::note("do_ruby_hook: $cmd");
}
my $rand = int(rand(1000));
my $st = system("$cmd 2>".story_cache_dir()."/$rand.err 1>".story_cache_dir()."/$rand.out");
if($st != 0){
die "do_ruby_hook failed. \n see ".story_cache_dir()."/$rand.err for details";
}
my $out_file = story_cache_dir()."/$rand.out";
open RUBY_HOOK_OUT, $out_file or die "can't open RUBY_HOOK_OUT file $out_file to read!";
my @out = <RUBY_HOOK_OUT>;
close RUBY_HOOK_OUT;
my $story_vars_json;
for my $l (@out) {
next if $l=~/#/;
ignore_story_err($1) if $l=~/ignore_story_err:\s+(\d)/;
if ($l=~s/story_var_json_begin.*// .. $l=~s/story_var_json_end.*//){
$story_vars_json.=$l;
next;
}
if ($l=~/story:\s+(\S+)/){
my $path = $1;
if (debug_mod12()){
main::note("run downstream story from ruby hook");
}
run_story($path, decode_json($story_vars_json||{}));
$story_vars_json = undef;
}
}
return 1;
}
sub do_python_hook {
my $file = shift;
my $python_lib_dir = File::ShareDir::dist_dir('Outthentic');
my $cmd = "PYTHONPATH=\$PYTHONPATH:".(story_cache_dir()).":$python_lib_dir python $file";
if (debug_mod12()){
main::note("do_python_hook: $cmd");
}
my $rand = int(rand(1000));
my $st = system("$cmd 2>".story_cache_dir()."/$rand.err 1>".story_cache_dir()."/$rand.out");
if($st != 0){
die "do_python_hook failed. \n see ".story_cache_dir()."/$rand.err for details";
}
my $out_file = story_cache_dir()."/$rand.out";
open PYTHON_HOOK_OUT, $out_file or die "can't open PYTHON_HOOK_OUT file $out_file to read!";
my @out = <PYTHON_HOOK_OUT>;
close PYTHON_HOOK_OUT;
my $story_vars_json;
for my $l (@out) {
next if $l=~/#/;
ignore_story_err($1) if $l=~/ignore_story_err:\s+(\d)/;
if ($l=~s/story_var_json_begin.*// .. $l=~s/story_var_json_end.*//){
$story_vars_json.=$l;
next;
}
if ($l=~/story:\s+(\S+)/){
my $path = $1;
if (debug_mod12()){
main::note("run downstream story from python hook");
}
run_story($path, decode_json($story_vars_json||{}));
$story_vars_json = undef;
}
}
return 1;
}
sub do_bash_hook {
my $file = shift;
my $bash_lib_dir = File::ShareDir::dist_dir('Outthentic');
my $cmd = "source "._bash_glue_file()." && source $bash_lib_dir/outthentic.bash";
$cmd.=" && source $file";
$cmd="bash -c '$cmd'";
if (debug_mod12()){
main::note("do_bash_hook: $cmd");
}
my $rand = int(rand(1000));
my $st = system("$cmd 2>".story_cache_dir()."/$rand.err 1>".story_cache_dir()."/$rand.out");
if($st != 0){
die "do_bash_hook failed. \n see ".story_cache_dir()."/$rand.err for details";
}
my $out_file = story_cache_dir()."/$rand.out";
open HOOK_OUT, $out_file or die "can't open HOOK_OUT file $out_file to read!";
my @out = <HOOK_OUT>;
close HOOK_OUT;
my %story_vars_bash = ();
for my $l (@out) {
next if $l=~/#/;
ignore_story_err($1) if $l=~/ignore_story_err:\s+(\d)/;
if ($l=~/story_var_bash:\s+(\S+)\s+(.*)/){
$story_vars_bash{$1}=$2;
#warn %story_vars_bash;
next;
}
if ($l=~/story:\s+(\S+)/){
my $path = $1;
if (debug_mod12()){
main::note("run downstream story from bash hook");
}
run_story($path, {%story_vars_bash});
%story_vars_bash = ();
}
}
return 1;
}
sub apply_story_vars {
my $story_vars = Outthentic::Story::Stat->current->{vars};
set_prop( story_vars => $story_vars );
open STORY_VARS, ">", (story_cache_dir())."/variables.json"
or die "can't open ".(story_cache_dir())."/variables.json write: $!";
print STORY_VARS encode_json($story_vars);
close STORY_VARS;
open STORY_VARS, ">", (story_cache_dir())."/variables.bash"
or die "can't open ".(story_cache_dir())."/variables.bash write: $!";
for my $name (keys %{$story_vars} ){
print STORY_VARS "$name=".$story_vars->{$name}."\n";
}
close STORY_VARS;
}
sub story_var {
my $name = shift;
get_prop( 'story_vars' )->{$name};
}
sub story_vars_pretty {
join " ", map { "$_:".(story_var($_)) } sort keys %{get_prop( 'story_vars' ) };
}
sub dump_os {
my $data;
open(my $fh, '-|', 'lsb_release -d 2>/dev/null; uname -a; cat /etc/issue; cat /etc/*-release 2>&1') or die $!;
while (my $line = <$fh>) {
$data.=$line;
}
close $fh;
$data;
}
sub _resolve_os {
if (!$OS){
my $data = dump_os();
$data=~/Minoca OS/i and $OS = "minoca";
$data=~/CentOS\s+.*release\s+(\d)/i and $OS = "centos$1";
$data=~/Red Hat.*release\s+(\d)/i and $OS = "centos$1";
$data=~/Ubuntu/i and $OS = 'ubuntu';
$data=~/Debian/i and $OS = 'debian';
$data=~/Arch\s+Linux/i and $OS = 'archlinux';
$data=~/Fedora\s+/i and $OS = 'fedora';
}
return $OS;
}
package main;
sub os { Outthentic::Story::_resolve_os }
1;
__END__